1

Тема: VBS: Вывод групп из AD

Здравствуйте, подскажите пожалуйста, есть код, который показывает в какие группы входит данный пользователь. Показывает Nested Group, но почему когда я его добавляю в приложение на .hta, скрипт больше не показывает Nested Group (т.е. вместо 10 записей выводит всего 3). Можете подсказать как решить данную проблемку?

.hta

Sub MemberGroupOf
		Const ForReading = 1, ForWriting = 2, ForAppend = 8
		Dim ObjUser, ObjRootDSE, ObjConn, ObjRS
		Dim GroupCollection, ObjGroup,StrUserName, StrDomName, StrSQL
		Dim GroupsList,WriteFile
		GroupsList = ""
		Set ObjRootDSE = GetObject("LDAP://RootDSE")
		StrDomName = Trim(ObjRootDSE.Get("DefaultNamingContext"))
		Set ObjRootDSE = Nothing
		'StrUserName = InputBox("Enter user login", "Info needed", "")
		StrUserName = "GilmullinRR"
		StrSQL = "Select ADsPath From 'LDAP://" & StrDomName & "' Where ObjectCategory = 'User' AND SAMAccountName = '" & StrUserName & "'"
		Set ObjConn = CreateObject("ADODB.Connection")
		ObjConn.Provider = "ADsDSOObject":  ObjConn.Open "Active Directory Provider"
		Set ObjRS = CreateObject("ADODB.Recordset")
		ObjRS.Open StrSQL, ObjConn
		If Not ObjRS.EOF Then
			ObjRS.MoveLast: ObjRS.MoveFirst
			Set ObjUser = GetObject (Trim(ObjRS.Fields("ADsPath").Value))
			Set GroupCollection = ObjUser.Groups
			strHtml = "Looking for groups " & StrUserName & " is member of. This may take some time..."
			For Each ObjGroup In GroupCollection
				GroupsList = GroupsList & VbCrLf & "<br>" & ObjGroup.CN 
				CheckForNestedGroup ObjGroup
			Next
			Set ObjGroup = Nothing: Set GroupCollection = Nothing:  Set ObjUser = Nothing
			strHtml = GroupsList
		Else
			strHtml = "Couldn't find user " & StrUserName & " in AD."
		End If
		ObjRS.Close:    Set ObjRS = Nothing
		ObjConn.Close:  Set ObjConn = Nothing
		vuvod.innerHTML = strHtml
	end sub

Оригинал .vbs

' ===============================================================================================================
' Get All Group-Membership of a User
' This Script will list All Groups, Including Nested Groups, Where a specified User-Account is a Member
' ===============================================================================================================

Option Explicit
Const ForReading = 1, ForWriting = 2, ForAppend = 8

Dim ObjUser, ObjRootDSE, ObjConn, ObjRS
Dim GroupCollection, ObjGroup
Dim StrUserName, StrDomName, StrSQL
Dim GroupsList
Dim WriteFile

GroupsList = ""

Set ObjRootDSE = GetObject("LDAP://RootDSE")
StrDomName = Trim(ObjRootDSE.Get("DefaultNamingContext"))
Set ObjRootDSE = Nothing

StrUserName = InputBox("Enter user login", "Info needed", "")
StrSQL = "Select ADsPath From 'LDAP://" & StrDomName & "' Where ObjectCategory = 'User' AND SAMAccountName = '" & StrUserName & "'"

Set ObjConn = CreateObject("ADODB.Connection")
ObjConn.Provider = "ADsDSOObject":  ObjConn.Open "Active Directory Provider"
Set ObjRS = CreateObject("ADODB.Recordset")
ObjRS.Open StrSQL, ObjConn
If Not ObjRS.EOF Then
    ObjRS.MoveLast: ObjRS.MoveFirst
    Set ObjUser = GetObject (Trim(ObjRS.Fields("ADsPath").Value))
    Set GroupCollection = ObjUser.Groups
    WScript.Echo "Looking for groups " & StrUserName & " is member of. This may take some time..."
    'Groups with direct membership, and calling recursive function for nested groups
    For Each ObjGroup In GroupCollection
        GroupsList = GroupsList + ObjGroup.CN + VbCrLf
        CheckForNestedGroup ObjGroup
    Next
    Set ObjGroup = Nothing: Set GroupCollection = Nothing:  Set ObjUser = Nothing
    'Writing list in a file named Groups <username>.txt
    Set WriteFile = WScript.CreateObject("WScript.Shell")
        'Dim fso, f
       ' Set fso = CreateObject("Scripting.FileSystemObject")
        'Set f = fso.OpenTextFile("Groups " & StrUserName & ".txt", ForWriting,true)
       ' f.write(GroupsList)
      '  f.Close
	  msgbox GroupsList
        WScript.Echo "You can find the list in the Groups " &StrUserName & ".txt file that has just been created."
Else
    WScript.Echo "Couldn't find user " & StrUserName & " in AD."
End If
ObjRS.Close:    Set ObjRS = Nothing
ObjConn.Close:  Set ObjConn = Nothing

Private Sub CheckForNestedGroup(ObjThisGroupNestingCheck)
    On Error Resume Next
    Dim AllMembersCollection, StrMember, StrADsPath, ObjThisIsNestedGroup, TabAdd, i 
    AllMembersCollection = ObjThisGroupNestingCheck.GetEx("MemberOf")
    For Each StrMember in AllMembersCollection
        If StrMember <> "" Then
            StrADsPath = "LDAP://" & StrMember
            Set ObjThisIsNestedGroup = GetObject(StrADsPath)
            'If InStr(GroupsList, ObjThisIsNestedGroup.CN) = 0 Then (Uncomment this If and indent lines below to remove groups already in the list)
            TabAdd = ""
            For i = 0 to Recurcount
                TabAdd = TabAdd & vbTab
            Next
            GroupsList = GroupsList & TabAdd & " " & ObjThisIsNestedGroup.CN & VbCrLf
            'End If
            'Recursion to include nested groups of nested groups
            Recurcount = Recurcount + 1
            CheckForNestedGroup ObjThisIsNestedGroup
            Recurcount = Recurcount - 1
        End If
    Next
    Set ObjThisIsNestedGroup = Nothing: Set StrMember = Nothing:    Set AllMembersCollection = Nothing
End Sub

2

Re: VBS: Вывод групп из AD

2shade45
Извини, чой то лень искать ошибку в том обрубке кода который ты привел.
Лучше я приведу свой рабочий вариант, только "region" в 3х местах замени на имя своего домена.
Если понравилось, то могу прислать 2ю половину кода (в ней - показ и удаление NTFS прав юзера на конкретные каталоги).

<html>
<head>
<meta http-equiv=content-type content="text-html; charset=utf-8">
<meta http-equiv=MSThemeCompatible content=yes>
<hta:application
	id="HTAApp"
	applicationName="Удаление прав пользователя"
	icon="UserAccountControlSettings.exe"
	maximizeButton="no"
	innerBorder="no"
	selection="no"
	contextMenu="no"
	singleinstance="yes"
	version="3.6"
 />
<style type="text/css">
	body, table {background-color:threedface;}
	body, input, table, legend {font-family:MS Shell Dlg; font-size:8pt;}
	legend, label {color:highlight;}
	legend {font-weight:bold;}
</style>
<script type="text/javascript">
	window.resizeTo(410, 260);
	document.title = HTAApp.applicationName + ' v.' + HTAApp.version;
	function CheckGroupName(name){
		return /^psn/i.test(name) ? "checked" : "disabled";
	}
	function SetHeight(){
		var height = idTable.scrollHeight;
		window.resizeTo(410, (height<800)?(height+40):800);
	}
	function ClearUsersList(){
		while (idUsers.firstChild) idUsers.removeChild(idUsers.firstChild);
		idUsers.add(document.createElement("OPTION"));
		idGroupsList.innerHTML = "";
		idFoldersList.innerHTML = "";
	}
	function idUsersOnchange(){
		GetUserGroups();
		GetFoldersRights();
		SetHeight();
	}
</script>
</head>
<body onload="CreateUsersList()" style="margin:0px;">
<table id="idTable" width="100%" cellpadding="2" cellspacing="4">
	<tr>
		<td align="center">
			<select id="idUsers" onchange="idUsersOnchange()" style="width:100%"></select>
		</td>
	</tr>
	<tr>
		<td>
			<fieldset><legend>&nbsp;Опции поиска пользователей:&nbsp;</legend>
				<input id="idFindRecursive" type="checkbox" checked onclick="CreateUsersList()" hidefocus><label for="idFindRecursive">поиск во вложенных контейнерах</label><br>
				<input id="idFindLock" type="checkbox" checked onclick="CreateUsersList()" hidefocus><label for="idFindLock">выводить заблокированных пользователей</label>
			</fieldset>
		</td>
	</tr>
	<tr height="100%">
		<td valign="top">
			<table width="100%" cellpadding="2" cellspacing="0">
				<tr>
					<td>
						<fieldset><legend>&nbsp;Является членом групп:&nbsp;</legend>
							<div id="idGroupsList"></div>
						</fieldset>
					</td>
				</tr>
				<tr>
					<td align="center" valign="top" height="40px">
						<input type="button" value="Удалить из отмеченных групп" onclick="RemoveFromGroups()" style="color:red" hidefocus>
					</td>
				</tr>
				<tr>
					<td valign="top">
						<fieldset><legend>&nbsp;Имеет индивидуальный доступ к каталогам:&nbsp;</legend>
							<div id="idFoldersList"></div>
						</fieldset>
					</td>
				</tr>
				<tr>
					<td align="center">
						<input type="button" value="Удалить доступ к отмеченным каталогам" onclick="RemoveFromFolders()" style="color:red" hidefocus>
					</td>
				</tr>
			</table>
		</td>
	</tr>
</table>
</body>
<script type="text/vbscript">
Sub CreateUsersList()
	ClearUsersList
	Set ObjRootDSE = GetObject("LDAP://RootDSE")
	strDomName = ObjRootDSE.Get("DefaultNamingContext")
	Set oOU = GetObject ("LDAP://" & strDomName)
	EnumObjWithContainer oOU
End Sub

Sub EnumObjWithContainer(oContainer)
	For Each oADO in oContainer
		Select Case oADO.Class
			Case "user"
				Set oOption = document.createElement("OPTION")
				oOption.text=oADO.cn
				oOption.value=oADO.sAMAccountName
				If oADO.AccountDisabled And idFindLock.checked Then
					oOption.style.color="red"
					idUsers.add(oOption)
				Else
					idUsers.add(oOption)
				End If
			Case "organizationalUnit"
				if idFindRecursive.checked Then EnumObjWithContainer oADO
		End Select 
	Next 
End Sub

Sub GetUserGroups()
	idGroupsList.innerHTML = ""
	username = idUsers.options(idUsers.selectedIndex).value
	Set oUser = GetObject("WinNT://region/" & username & ",user")
	For Each oGroup In oUser.Groups
		If LCase(oGroup.Class) = "group" Then
			chk = CheckGroupName(oGroup.Name)
			idGroupsList.insertAdjacentHTML "BeforeEnd", "<input id=idGroups type=checkbox " & chk & " value=""" & oGroup.Name & """ hidefocus>" & oGroup.Name & "<br>"
		End If
	Next
	idUsers.focus
End Sub

Sub RemoveFromGroups()
	username = idUsers.options(idUsers.selectedIndex).value
	Set oUser = GetObject("WinNT://region/" & username & ",user")
	For Each group In document.getElementsByName("idGroups")
		If group.checked Then
			Set oGroup = GetObject("WinNT://region/" & group.value & ",group")
			oGroup.Remove(oUser.ADsPath)
		End If
	Next
	GetUserGroups
End Sub

</script>
</html>

3 (изменено: shade45, 2015-12-24 10:39:37)

Re: VBS: Вывод групп из AD

mozers Ваш код конечно хорош, но у меня завис(, он собирает в себя всех пользователей домена

Полный код для проверки, там с помощью msgbox видно как он работает, показывает половину шесть из 10 значений нормально, потом стирает все, пишет 7, 8 значения, потом все стирает и пишет сверху 9 и 10 значения только

<html>
<head>
<meta http-equiv=content-type content="text-html; charset=utf-8">
<meta http-equiv=MSThemeCompatible content=yes>
<hta:application
	id="HTAApp"
 />
 </head>
 <script type="text/vbscript">
 
Sub MemberGroupOf
		Const ForReading = 1, ForWriting = 2, ForAppend = 8
		Dim ObjUser, ObjRootDSE, ObjConn, ObjRS
		Dim GroupCollection, ObjGroup,StrUserName, StrDomName, StrSQL
		Dim GroupsList,WriteFile
		GroupsList = ""
		Set ObjRootDSE = GetObject("LDAP://RootDSE")
		StrDomName = Trim(ObjRootDSE.Get("DefaultNamingContext"))
		Set ObjRootDSE = Nothing
		StrUserName = InputBox("Enter user login", "Info needed", "")
		'StrUserName = "GilmullinRR" 'ВВЕДИТЕ ЛОГИН для ПОИСКА
		StrSQL = "Select ADsPath From 'LDAP://" & StrDomName & "' Where ObjectCategory = 'User' AND SAMAccountName = '" & StrUserName & "'"
		Set ObjConn = CreateObject("ADODB.Connection")
		ObjConn.Provider = "ADsDSOObject":  ObjConn.Open "Active Directory Provider"
		Set ObjRS = CreateObject("ADODB.Recordset")
		ObjRS.Open StrSQL, ObjConn
		If Not ObjRS.EOF Then
			ObjRS.MoveLast: ObjRS.MoveFirst
			Set ObjUser = GetObject (Trim(ObjRS.Fields("ADsPath").Value))
			Set GroupCollection = ObjUser.Groups
			'strHtml = "Looking for groups " & StrUserName & " is member of. This may take some time..."
			For Each ObjGroup In GroupCollection
				GroupsList = GroupsList & VbCrLf & "<br>" & ObjGroup.CN 
				CheckForNestedGroup ObjGroup
			Next
			
			Set ObjGroup = Nothing: Set GroupCollection = Nothing:  Set ObjUser = Nothing
			strHtml = strHtml & GroupsList
		Else
			strHtml = "Couldn't find user " & StrUserName & " in AD."
		End If
		ObjRS.Close:    Set ObjRS = Nothing
		ObjConn.Close:  Set ObjConn = Nothing
		DataArea.innerHTML = strHtml
	end sub

	Sub CheckForNestedGroup(ObjThisGroupNestingCheck)
		On Error Resume Next
		Dim AllMembersCollection, StrMember, StrADsPath, ObjThisIsNestedGroup, TabAdd, i 
		AllMembersCollection = ObjThisGroupNestingCheck.GetEx("MemberOf")
		For Each StrMember in AllMembersCollection
			If StrMember <> "" Then
				StrADsPath = "LDAP://" & StrMember
				Set ObjThisIsNestedGroup = GetObject(StrADsPath)
				If InStr(GroupsList, ObjThisIsNestedGroup.CN) = 0 Then '(Uncomment this If and indent lines below to remove groups already in the list)
				'TabAdd = ""
				For i = 0 to Recurcount
					TabAdd = TabAdd & vbTab
				Next
				'GroupsList = GroupsList & TabAdd & " " & ObjThisIsNestedGroup.CN & VbCrLf
				GroupsList = GroupsList & ObjThisIsNestedGroup.CN & VbCrLf
				End If
				msgbox GroupsList
				
				
				'Recursion to include nested groups of nested groups
				Recurcount = Recurcount + 1
				CheckForNestedGroup ObjThisIsNestedGroup
				Recurcount = Recurcount - 1
			End If
			
			
			strHtml = GroupsList
			DataArea.innerHTML = strHtml
			
		Next
		Set ObjThisIsNestedGroup = Nothing: Set StrMember = Nothing:    Set AllMembersCollection = Nothing
End Sub



</script>
<body>
<input type="button" id="MemberGroupOf1" onclick="MemberGroupOf()" value="MemberGroupOf">
	<div class="right_col">
		<span id = "DataArea" name="value">нажмите.</span>
	</div>
</body>
</html>

1 картинка - как выводит в .hta
http://s020.radikal.ru/i701/1512/c4/10ed9bb5be45t.jpg
1 картинка - как выводит в .vbs - msgbox
http://s014.radikal.ru/i328/1512/4e/7d347b8a22c6t.jpg

4

Re: VBS: Вывод групп из AD

А если закомментить 34 строку?

5 (изменено: mozers, 2015-12-24 14:59:00)

Re: VBS: Вывод групп из AD

shade45 пишет:

код конечно хорош, но у меня завис(, он собирает в себя всех пользователей домена

Это - точно. Чтоб брал только с конкретного OU надо в 97 строке вместо strDomName вставить LDAP string вашего OU. Типа так:

Set oOU = GetObject ("LDAP://OU=Users,OU=city,DC=firma,DC=ru")

А твоя hta-шка у меня отработала без ошибок, но у нас вложенные группы не практикуются, так что Flasher сделал верное предположение.

6

Re: VBS: Вывод групп из AD

mozers если закомментировать 34 строчку, тогда отобразить только "внешние" группы, вложенные не появяться. Странно, почему он поверх то пишет, если я вывожу в .txt, то все хорошо проходит с помощью добавления:

  Writing list in a file named Groups <username>.txt
    Set WriteFile = WScript.CreateObject("WScript.Shell")
        Dim fso, f
        Set fso = CreateObject("Scripting.FileSystemObject")
       Set f = fso.OpenTextFile("Groups " & StrUserName & ".txt", ForWriting,true)
        f.write(GroupsList)
        f.Close 

7

Re: VBS: Вывод групп из AD

			strHtml = GroupsList
			DataArea.innerHTML = strHtml
		Next

на

		Next
		DataArea.innerHTML = GroupsList

8 (изменено: mozers, 2015-12-25 11:42:30)

Re: VBS: Вывод групп из AD

Flasher, согласен.
А еще лучше не формировать strHtml, а писать сразу в DataArea.

DataArea.insertAdjacentHTML "BeforeEnd", ObjGroup.CN & "<br>" 

9

Re: VBS: Вывод групп из AD

пробовал не помогло, это добавлял чтобы посмотреть как она отрабатывает, про то что я выше писал, она пишет первые несколько групп, потом стирает и поверх пишет другие.

Оригинальный код:
http://stackoverflow.com/questions/2611 … epetitions

10

Re: VBS: Вывод групп из AD

shade45
Странная манера задавать вопрос и даже не пробовать использовать данный ответ.
Вот взял твой скрипт, поудалял все лишнее и применил все, данные выше, советы

<html>
<head>
<meta http-equiv=content-type content="text-html; charset=utf-8">
<meta http-equiv=MSThemeCompatible content=yes>
<hta:application />
</head>
<script type="text/vbscript">
	Sub MemberGroupOf()
		StrDomName = Trim(GetObject("LDAP://RootDSE").Get("DefaultNamingContext"))
		StrSQL = "Select ADsPath From 'LDAP://" & StrDomName & "' Where ObjectCategory = 'User' AND SAMAccountName = '" & idUser.Value & "'"
		Set ObjConn = CreateObject("ADODB.Connection")
		ObjConn.Provider = "ADsDSOObject":  ObjConn.Open "Active Directory Provider"
		Set ObjRS = CreateObject("ADODB.Recordset")
		ObjRS.Open StrSQL, ObjConn
		If Not ObjRS.EOF Then
			ObjRS.MoveLast: ObjRS.MoveFirst
			Set ObjUser = GetObject(Trim(ObjRS.Fields("ADsPath").Value))
			Set GroupCollection = ObjUser.Groups
			For Each ObjGroup In GroupCollection
				DataArea.insertAdjacentHTML "BeforeEnd", ObjGroup.CN & "<br>"
				CheckForNestedGroup ObjGroup
			Next
			Set ObjGroup = Nothing: Set GroupCollection = Nothing:  Set ObjUser = Nothing
		Else
			alert "Couldn't find user " & idUser.Value & " in AD."
		End If
		ObjRS.Close:    Set ObjRS = Nothing
		ObjConn.Close:  Set ObjConn = Nothing
	End Sub

	Sub CheckForNestedGroup(ObjThisGroupNestingCheck)
		On Error Resume Next
		AllMembersCollection = ObjThisGroupNestingCheck.GetEx("MemberOf")
		For Each StrMember In AllMembersCollection
			If StrMember <> "" Then
				StrADsPath = "LDAP://" & StrMember
				Set ObjThisIsNestedGroup = GetObject(StrADsPath)
				If InStr(GroupsList, ObjThisIsNestedGroup.CN) = 0 Then
					DataArea.insertAdjacentHTML "BeforeEnd", "&nbsp;&nbsp;&nbsp;" & ObjThisIsNestedGroup.CN & "<br>"
				End If
				CheckForNestedGroup ObjThisIsNestedGroup
			End If
		Next
		Set ObjThisIsNestedGroup = Nothing: Set StrMember = Nothing:    Set AllMembersCollection = Nothing
	End Sub
</script>
<body>
Пользователь: <input type="text" id="idUser">
<input type="button" onclick="MemberGroupOf()" value="Является членом групп">
<div id="DataArea"></div>
</body>
</html>

Что непонятно?