VBS/WSH/JS - Определения членства в группах

VBS/WSH/JS - Определения членства в группах

Новый участник

Сообщения: 29
Благодарности: 0

Добрый день!
Вопрос такой - есть скрипт ниже, это HTA приложение которое встраивается в косноль mmc, в качестве параметра берет имя выделенного пользователя пред-windows2000 и по нему определяет в каких группах состоит этот юзер. Проблема в том что у нас в конторе имена пред-windows2000 имеют вид Фамилия Имя (Иванов Иван - пример). Этот же скрипт берет только первую часть имени до пробела, то есть Иванов, и естевственно не находит такого пользователя. Что нужно изменить что бы в качестве параметра принимось имя полностью.

Код:

<html>
<head>
<!--
Created with SAPIEN Technologies PrimalScript 2007

NAME: MemberOf_Report.HTA

AUTHOR: Dan Holme , Intelliem
DATE  : 12/16/2007

This HTA allows you to view the memberships of a user, group, or computer
See Solutions Collection 8, MemberOf_Report_V2.hta for an improved version

Neither Microsoft nor Intelliem guarantee the performance
of scripts, scripting examples or tools.

See www.intelliem.com/resourcekit for updates to this script

(c) 2007 Intelliem, Inc
-->
<title>Group Membership Report</title>
<hta:application
	id="oGroupMembershipReport">

<!-- Note this HTA can be called from a command line
	 HTANAME.hta ObjectName
	 Where 
	 HTANAME.hta is the filename of this HTA
	 ObjectName is 
	 	the Pre-Windows 2000 Logon Name, DN or ADsPath
	 	of a user, computer, or group -->
	 	
<script language="vbscript">

Option Explicit
Dim oMemberOfList
Dim sDomainDN
' CONFIGURATION BLOCK
sDomainDN = "dc=corp,dc=ertelecom,dc=loc"
Dim aArguments	

Sub Window_Onload
	Call CenterMe(250,500)
	aArguments = HTA_Arguments(oGroupMembershipReport)
	If uBound(aArguments) >= 0 Then
		' An argument was passed to the HTA
		' Prepopulate the text box and then run the main routine 
		txtObjectDN.value = aArguments(0)
		Call MainRoutine()
	End If
End Sub

Sub MainRoutine()
	Dim aMemberOfList
	Dim sMemberOf
	Dim sResults
	Dim sObjectDN
	
	sObjectDN = ADObject_DN_UCG(txtObjectDN.value, sDomainDN)
	If sObjectDN = "" Then
		MsgBox "Could not find " & txtObjectDN.value
	End If
	
	' Create dictionary object to store group names
	Set oMemberOfList = CreateObject("Scripting.Dictionary")
	' Set comparison mode to case insensitive
	oMemberOfList.CompareMode = vbTextCompare
	
	Call ADObject_MemberOf (sObjectDN)
	aMemberOfList = oMemberOfList.Keys
	aMemberOfList = Array_Sort(aMemberOfList)
	sResults = "MEMBERSHIPS"
	For Each sMemberOf In aMemberOfList
		sResults = sResults & "<br/>" & sMemberOf
	Next
	
	divResults.innerHTML = sResults
End Sub

' ======================
' FUNCTIONS FROM LIBRARY
' ======================
Function ADObject_DN_UCG(ByVal sObject, sSearchDN)
	' Version 070706
	' Takes any input (name, DN, or ADsPath) of a user, computer, or group,
	' and returns the distinguished name of the object
	' INPUTS:	sObject: name, DN or ADsPath to a user, group, or computer
	'			sSearchDN: the DN within which to search (often, the DN of the domain, e.g. dc=contoso, dc=com)
	' RETURNS:	ADObject_DN_UCG: distinguished name (cn=...) of the object
	' REQUIRES:	ADObject_Find_UCG routine
	
	Dim sObjectName, oObject, sObjectADsPath, sObjectDN
	
	If Len(sObject) = 0 Then
		sObjectDN = ""
	ElseIf Len(sObject) < 3 Then
		' can't be a DN or an ADsPath - must be a name
		sObjectADsPath = ADObject_Find_UCG(sObject, sSearchDN)
		If sObjectADsPath <> "" Then sObjectDN = mid(sObjectADsPath,8)
	ElseIf LCase(Left(sObject,3)) = "cn=" Then
		' is a DN - make sure it exists
		On Error Resume Next
		Set oObject = GetObject("LDAP://" & sObject)
		sObjectDN = oObject.distinguishedName
		If Err.Number <> 0 Then
			' Error - couldn't find object
			sObjectDN = ""
			Err.Clear
		End If
		On Error GoTo 0
	ElseIf Len(sObject) < 8 Then
		' can't be an ADsPath and isn't a DN, must be a name
		sObjectADsPath = ADObject_Find_UCG(sObject, sSearchDN)
		If sObjectADsPath <> "" Then sObjectDN = mid(sObjectADsPath,8)
	ElseIf Ucase(Left(sObject, 7)) = "LDAP://" Then
		' is an ADsPath - make sure it exists
		' first, make sure LDAP:// is upper case, to avoid error
		sObject = "LDAP://" & Mid(sObject, 8)
		On Error Resume Next
		Set oObject = GetObject(sObject)
		sObjectDN = oObject.distinguishedName
		If Err.Number <> 0 Then
			' Error - couldn't find object
			sObjectDN = ""
			Err.Clear
		End If
		On Error GoTo 0
	Else
		' must be a name
		sObjectADsPath = ADObject_Find_UCG(sObject, sSearchDN)
		If sObjectADsPath <> "" Then sObjectDN = mid(sObjectADsPath,8)
	End If

	ADObject_DN_UCG = sObjectDN

End Function

Function ADObject_Find_UCG(sObjectName, sSearchDN)
	' VERSION 070706
	' Returns the full ADsPath (LDAP://...) of a user, computer, or group
	' Inputs:
	' 		sObjectName: The unique identifier for the object class.  The script supports:
	'			User: 		sAMAccountName (pre-Windows 2000 logon name)
	'			Group: 		sAMAccountName (pre-Windows 2000 logon name)
	'			Computer: 	Name (translated by the script to the computer's sAMAccountName by adding a $)
	' 		sSearchDN: the DN within which to search (often, the DN of the domain, e.g. dc=contoso, dc=com)

	Dim oConnection
	Dim oRecordset
	Dim sLDAPObjectQuery
	Dim sLDAPIdentifierQuery
	Dim sLDAPQuery
	Dim sProperties
	Dim oADObject
	Dim aProperties
	Dim sProperty
	Dim sLDAPIdentifier
	Dim sSearchScope
	
	sLDAPIdentifier = "samAccountName"
	sProperties = "ADsPath"
	sSearchScope = "subtree"
	
	' Open an ADO connection using null credentials
	Set oConnection = CreateObject("ADODB.Connection")
	oConnection.Provider = "ADsDSOObject"
	'On Error Resume Next
	oConnection.Open "", vbNullString, vbNullString
	If oConnection.State = 0 Then ' 0 = adStateClosed
	     ' Error handling code: can't connect to AD
	     ADObject_Find_UCG = ""
	     Exit Function
	End If
	
	' Build the LDAP Query
	sLDAPQuery = "<LDAP://" & sSearchDN & ">;"
	sLDAPQuery = sLDAPQuery & _
		"(|(samAccountName=" & sObjectName & ")" & _
		"(samAccountName=" & sObjectName & "$));" & _
		sProperties & ";" & sSearchScope
	
	' Retrieve the result set, close the connection, and check to make
	' sure we received at least one result
	Set oRecordset = oConnection.Execute (sLDAPQuery)
	If oRecordset.EOF and oRecordset.BOF Then
		' Error handling code: no object found
	    ADObject_Find_UCG = ""
	     Exit Function
	End If
	
	ADObject_Find_UCG = oRecordset.Fields("ADsPath")
	oRecordset.Close
	oConnection.Close
	
End Function

Sub ADObject_MemberOf(ByVal sObjectDN)
	' Version 070701
	' Enumerates the group memberships of a user or computer
	' INPUTS:	sObjectDN: the DN of the user or computer
	' RETURNS:	oMemberOfList sorted with each group
	'			to which the user or computer belongs.
	' REQUIRES:	ADObject_MemberOf_Enum function
	'			Array_Sort function
	'			oMemberOf List with global scope
	'			e.g.
	'			Set oMemberOfList = CreateObject("Scripting.Dictionary")
	'			oMemberOfList.CompareMode = vbTextCompare ' Case INsensitive
	
	Dim oObject
	Dim iPrimaryGroup
	Dim sPrimaryGroup
	Dim aMemberOf
	
	On Error Resume Next
	Set oObject = GetObject("LDAP://" & sObjectDN)
	If Err.Number<>0 Or oObject Is Nothing Then
		Err.Clear
		Exit Sub
	End If
	On Error GoTo 0

	If oObject.Class = "computer" Or oObject.Class = "user" Then
		iPrimaryGroup = oObject.PrimaryGroupID
		sPrimaryGroup = ""
		Select Case iPrimaryGroup
			Case 513
				sPrimaryGroup = "Domain Users"
			Case 514
				sPrimaryGroup = "Domain Guests"
			Case 515
				sPrimaryGroup = "Domain Computers"
			Case 516
				sPrimaryGroup = "Domain Controllers"
		End Select
		If sPrimaryGroup > "" Then
			Call ADObject_MemberOf_Enum(sPrimaryGroup)
			oMemberOfList.Add sPrimaryGroup, True
		End If
	End If
	
	On Error Resume Next
	aMemberOf = oObject.GetEx("memberOf")
	If Err.Number <> 0 Then
		' Assume error is because memberOf has no distinguished names
		Err.Clear
		On Error GoTo 0
		Exit Sub
	Else
		On Error GoTo 0
		Call ADObject_MemberOf_Enum(oObject)
	End If
		
End Sub 

Sub ADObject_MemberOf_Enum(ByVal oObject)
    ' Version 070701
    ' Enumerates MemberOf property of an object
    ' INPUTS:	oObject: object for which to enumerate MemberOf
    ' REQUIRES:	oMemberOfList dictionary object with global scope
	'			e.g.
	'			Set oMemberOfList = CreateObject("Scripting.Dictionary")
	'			oMemberOfList.CompareMode = vbTextCompare ' Case INsensitive
	
	Dim aMemberOf
	Dim sMemberOf
	Dim oMemberOf
	Dim sMemberOfSAM
	
	On Error Resume Next
	aMemberOf = oObject.GetEx("memberOf")
	If Err.Number <> 0 Then
		' Assume error is because memberOf has no distinguished names
		Err.Clear
		On Error GoTo 0
		Exit Sub
	Else
		On Error GoTo 0
		For Each sMemberOf In aMemberOf
			Set oMemberOf = GetObject("LDAP://" & sMemberOf)
			sMemberOfSAM = oMemberOf.sAMAccountName
			If (oMemberOfList.Exists(sMemberOfSAM) = False) Then
				' We have not seen this group yet
				' Add it to the dictionary object
				oMemberOfList.Add sMemberOfSAM, True
				' Enumerate this group's nested memberships
				Call ADObject_MemberOf_Enum(oMemberOf)
			End If
	    Next
	End If

End Sub

Function Array_Sort(ByVal aArray) 
	' VERSION 070701
	' Sorts an array, very quickly, using .NET objects
	' INPUTS:	aArray: an array (incl Dictionary object) requiring sort
	' RETURNS:	Array_Sort: sorted
	' REQUIRES:	.NET Framework 2.0
	
    Dim oNAL
    Dim nIdx
    
    Set oNAL = CreateObject("System.Collections.ArrayList")
    For nIdx = 0 To UBound(aArray)
        oNAL.Add aArray(nIdx)
    Next
    
    oNAL.Sort
    
    For nIdx = 0 To UBound(aArray)
        aArray(nIdx) = oNAL(nIdx) 
    Next 
    
    Array_Sort = aArray
    
End Function


Function HTA_Arguments(ByRef oHTA)
	' Version 071127
	' Interprets the command line used to call the HTA
	' and creates an arguments collection.
	' Inputs:	oHTA:	the HTA application object, as defined in the
	'					<hta:application id="xxxx" ...> id attribute
	'					(e.g. you would pass xxxx as the argument)
	' 			command line used to call this hta should use quotes
	'			around the path/name of the HTA itself as well as
	'			around each argument.
	'			quotes embedded in arguments will mess it up, so don't
	'			use any. For example:
	'			[mshta.exe] "path\filename.hta" ["argument 1" ["argument 2" ...]]
	' Outputs:	HTA_Arguments():	an array of arguments
	' Requires:	Text_Delimited_Parse() function
	
	Dim aSplit, i, aArguments, sCommandLine
	sCommandLine = oHTA.commandline
	i = InStr(1, sCommandLine, ".hta", vbTextCompare)
	If i = 0 Then Exit Function
	i = InStr(i, sCommandLine, " ")
	If i = 0 OR Len(sCommandLine) = i Then
		HTA_Arguments = Split("",",")
		Exit Function
	End If
	sCommandLine = Mid(sCommandLine, i+1)
	 
	HTA_Arguments = Text_Delimited_Parse(sCommandLine, " ", True)
	
End Function

Function Text_Delimited_Parse(ByVal sTextLine, ByVal sDelimiter, ByVal bTrim)
	' Version 070708
	'
    ' Parse delimited text into its components (elements)
    ' and return an array of those elements
    '
    ' Allows for "qualified" elements
    '
    ' To embed a delimiter (e.g. a comma)
    ' surround the element with double-quotes
    ' e.g. "This is one, and only one, element"
    '
    ' To embed a quote, use a double-double quote
    ' e.g. "He said, ""This is one element."""
    ' would result in: He said, "This is one element."
    ' being treated as one element in the delimited text line
    '
    ' INPUTS: 	sTextLine - a line of delimited text
    '			sDelimiter - the delimiter (e.g. a comma)
    '			bTrim - trim trailing and leading spaces
    ' RETURNS:	Text-Delimited_Parse() - an Array

    Dim aElements
    Dim bIgnore
    Dim bNewElement
    Dim iElementCount
    Dim iPosition
    Dim iStart
    Dim sChar
    Dim sValue
	Dim QUOTE
	Dim DOUBLEQUOTE
	
    QUOTE = Chr(34)
    DOUBLEQUOTE = QUOTE & QUOTE

    ' Check for empty string and return empty array.
    If bTrim then sTextLine = Trim(sTextLine)
    If (Len(sTextLine) = 0) then
        Text-Delimited_Parse = Array()
        Exit Function
    End If

    ' Initialize.
    bIgnore = False
    bNewElement = True
    iElementCount = 0
    iStart = 1
    aElements = Array()

    ' Add a delimiter to delimit the last element
    sTextLine = sTextLine & sDelimiter

    ' Process each character of text
    For iPosition = 1 To Len(sTextLine)
        sChar = Mid(sTextLine, iPosition, 1)
        Select Case sChar
            Case QUOTE
                ' Toggle the Ignore flag
                If bIgnore And Len(sTextLine) > iPosition Then
                	' We're already "inside" the qualifier (quotes)
                	' so check to see if this is a double quote
                	If Mid(sTextLine, iPosition+1, 1) = Quote Then
                		' We have a double quote. Skip over it.
                		iPosition = iPosition + 1
                	Else
                		' The next character is not a quote, so
                		' Flip the ignore flag -- this is either the
                		' beginning or the end of a quote-qualified item
                		bIgnore = Not bIgnore
                	End If
                Else
                	' We're not "inside" a qualifier or
                	' we're at the end of the string and have found a quote
                	bIgnore = Not bIgnore
                End If
            Case sDelimiter
                If Not bIgnore Then
                	' We found a delimiter, 
                	' and we're not "inside" the qualifier (quotes)
                    ' So we add this element to the array.
                    ReDim Preserve aElements(iElementCount)
                    If iPosition - iStart = 0 Then
						' The element is empty
                    	aElements(iElementCount) = Empty
                    Else
                        ' Get the element
                        sValue = Mid(sTextLine, iStart, _
                            iPosition - iStart)
                        If bTrim then sValue = Trim (sValue)
                        ' If the element is qualified with quotes,
                        ' remove them and replace
                        ' double-double quotes with double-quotes
                        If (Left(sValue, 1) = QUOTE) Then
                        	sValue = Mid(sValue, 2, Len(sValue) - 2)
                        	sValue = Replace(sValue, DOUBLEQUOTE, QUOTE)
                        End If
						aElements(iElementCount) = sValue
						' DEBUG: WScript.Echo ": " & sValue
                    End If
                    ' Prepare for next element
                    iElementCount = iElementCount + 1
                    iStart = iPosition + 1
                    bNewElement = True
                End If
			Case " "
				If bNewElement AND bTrim Then
					' We're starting a new element and this is a leading space
					' that should be trimmed
					iStart = iPosition + 1
				End If
			Case Else
				' Turn off the 'leading space' flag
				bNewElement = False
        End Select
    Next
    Text_Delimited_Parse = aElements
End Function

Sub CenterMe(iSizeH, iSizeV)
		' VERSION 070709
		' Repositions the window to be centered and sized
		' INPUTS:	iSizeH:	The desired horizontal size of the window
		'			iSizeV:	The desired vertical size of the window
		' NOTE:		Windows Server 2008 does not expose the
		'			display resolution, by default, so the routine
		'			will only size the window in the event that the
		'			resolution is not available
		
		Dim sComputer, oWMIService, cItems, oItem
		Dim iResolutionH, iResolutionV, iPositionH, iPositionV
		
		' Get this computer's display resolution
        sComputer = "."
        Set oWMIService = GetObject("winmgmts:\\" & sComputer & "\root\cimv2")
        Set cItems = oWMIService.ExecQuery("Select * From Win32_DesktopMonitor")
        For Each oItem in cItems
            iResolutionH = oItem.ScreenWidth
            iResolutionV = oItem.ScreenHeight
        	' Windows Server 2008 does not provide the ScreenHeight & ScreenWidth by default
        	' so, below, we have to provide for this possibility
        Next
        
        ' Calcultate the "centered" position
        iPositionH = (iResolutionH - iSizeH) / 2
        iPositionV = (iResolutionV - iSizeV) / 2
        
        ' Resize and reposition the window
        window.resizeTo iSizeH, iSizeV
        If iResolutionH >0 and iResolutionH > 0 Then
        	window.moveTo iPositionH, iPositionV
        End If
        
End Sub

</script>

<style>
	body, tr, td, table, p, input {font-family: arial; font-size: 9pt;}
</style>

</head>
<body>
User, group or computer name:<br/>
<input type="text" name="txtObjectDN" id="txtObjectDN" size="20"  onchange="MainRoutine()"/>
<br/>
<input type="button" value="Report" id="btnGo" name="btnGo" onclick="MainRoutine()"/>
<h3>Group memberships</h3>
<div id="divResults" name="divResults"> </div>
</body>
</html>

Спасибо!

Отправлено: 12:38, 30-11-2010

vitaliyboch

Пользователь

Сообщения: 72
Благодарности: 27

Профиль | Сайт | Отправить PM | Цитировать

лично у меня работает как с пробелами, так и без. Специально переименовал одного тестового пользователя (вставил ему пробел в пред-windows2000) и проверил. Также и по русски обозвал тестового пользователя - тоже работает.
выполняю на компе с Windows 7
доменный контроллер на Windows Server 2003

-------
Статьи для системных инженеров http://www.sysengineering.ru

Отправлено: 10:56, 21-12-2010 | #2

Для отключения данного рекламного блока вам необходимо зарегистрироваться или войти с учетной записью социальной сети.

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