| malkinfedor |
30-11-2010 12:38 1554966 |
Определения членства в группах
Добрый день!
Вопрос такой - есть скрипт ниже, это 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>
Спасибо! |
