如何为“LDAP://”提供主机名和凭据?

时间:2015-10-08 10:05:19

标签: vbscript active-directory ldap ldap-query

我需要有一个基于几个DN的Active Directory Shadow Groups(又名Active Directory Dynamic Group)。

我搜索了一个简单的工具,可以让我这样做,最后在http://kb.caresys.com.cn/4052785/need-script-add-all-accounts-active-directory-security-group(以及其他一些地方)找到了Dan Holme的优秀剧本(引用如下) 我还发现了几个PowerShell脚本,但它们似乎都有更难的依赖关系,我需要一个尽可能独立的工具。他们也遇到了我在这里面临的同样问题。

Group_Shadow.vbs脚本完全符合我的需要,但有一个例外: 我需要能够指定AD的主机,端口号和凭据(登录名和密码)。

该脚本假定"LDAP://"指向正确的AD,我想AD凭据是从运行脚本的用户派生的?

我确实通过将"LDAP://"字符串更改为"LDAP://LDAP_HOST:LDAP_PORT/"找到了有关如何设置主机名和密码的提示。 这似乎很容易实现 - 但是有一些评论表明它不起作用......

我还发现了有关设置凭据的提示:

Dim LDAP ' As IADsOpenDSObject 
Set LDAP = GetObject("LDAP:") 
Set obj = LDAP.OpenDSObject("LDAP://", "domain\name", "password", ADS_USE_ENCRYPTION OR ADS_SECURE_AUTHENTICATION)

这似乎很难(在VBScript和Active Directory世界中都是新手),我根本无法弄清楚如何组合成两个。

我希望社区可以通过协助修复此脚本或指向不同的解决方案来帮助我。

提前致谢!

剧本:

'==========================================================================
'
' VBScript Source File -- Created with SAPIEN Technologies PrimalScript 2007
'
' NAME: Group_Shadow.vbs
'
' AUTHOR: Dan Holme , Intelliem
' DATE  : 12/12/2007
'
' USAGE:  
' cscript.exe Group_Shadow.vbs
'
' Dynamically updates the membership of a group
' to match the objects returned from an Active Directory query
'
' See the Windows Administration Resource Kit for documentation
'
' 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
'==========================================================================
Option Explicit

Dim sDomainDN
Dim sGroupSAMAccountName
Dim aSearchOUs
Dim sQuery

'==========================================================================
' CONFIGURATION BLOCK
' Domain's DN
sDomainDN = "dc=domain,dc=local"
' sAMAccountName of shadow group
sGroupSAMAccountName = "Security Group"
' An array of one or more OUs to search
aSearchOUs = Array("ou=Something,dc=domain,dc=local")
' LDAP query that will be run in each OU
sQuery = " (&(objectCategory=computer)(name=GA*));distinguishedName;subtree"
'==========================================================================

' Create dictionaries
Dim dResults
Set dResults = CreateObject("Scripting.Dictionary")
dResults.CompareMode = vbTextCompare ' Case INsensitive
Dim dTargetMembership
Set dTargetMembership = CreateObject("Scripting.Dictionary")
dTargetMembership.CompareMode = vbTextCompare ' Case INsensitive
Dim dCurrentMembership
Set dCurrentMembership = CreateObject("Scripting.Dictionary")
dCurrentMembership.CompareMode = vbTextCompare ' Case INsensitive
Dim dMembershipChanges
Set dMembershipChanges = CreateObject("Scripting.Dictionary")
dMembershipChanges.CompareMode = vbTextCompare ' Case INsensitive

' Perform LDAP searches, adding to final list stored in dTargetMembership
Dim sSearchOU
Dim sLDAPQuery
For Each sSearchOU In aSearchOUs
    sLDAPQuery = "<LDAP://" & sSearchOU & ">;" & sQuery
    Set dResults = AD_Search_Dictionary(sLDAPQuery)
    Call DictionaryAppend(dResults, dTargetMembership)
Next

' Locate group
Dim sGroupADsPath
Dim oGroup
sGroupADsPath = ADObject_Find_Generic(sGroupSAMAccountName, sDomainDN)
If sGroupADsPath = "" Then
    ' Error handling: group not found
    WScript.Quit
End If
Set oGroup = GetObject(sGroupADsPath)

' Get members and store in dictionary
Dim aMembers
aMembers = oGroup.GetEx("member")
Set dCurrentMembership = ArrayToDictionary(aMembers)

' Calculate the "delta" between the current and desired state
Set dMembershipChanges = Dictionary_Transform(dCurrentMembership, dTargetMembership)

' Make the membership changes based on the transform dictionary's instructions
Dim sMember
For Each sMember In dMembershipChanges
    If UCase(dMembershipChanges.Item(sMember)) = "ADD" Then
        oGroup.Add "LDAP://" & sMember
    End If
    If UCase(dMembershipChanges.Item(sMember)) = "DELETE" Then
        oGroup.Remove "LDAP://" & sMember
    End If
Next

WScript.Quit

' ======================
' FUNCTIONS FROM LIBRARY
' ======================

' #region Dictionary routines

Function ArrayToDictionary(ByRef aArray)
    ' Converts a one-dimensional array into a dictionary.
    ' Assumes elements in array are unique
    Dim dDic
    Dim aElement
    Set dDic = CreateObject("Scripting.Dictionary")
    dDic.CompareMode = vbTextCompare ' Case INsensitive

    On Error Resume Next ' trap duplicate array elements
    For Each aElement In aArray
        dDic.Add aElement, 0        
    Next
    On Error GoTo 0

    Set ArrayToDictionary = dDic
End Function

Sub DictionaryAppend(ByRef dNewElements, ByRef dDictionary)
    ' Appends the elements of dNewElements to dDictionary
    Dim sKey

    On Error Resume Next ' trap duplicate array elements
    For Each sKey In dNewElements.keys
        dDictionary.Add sKey, dNewElements.Item(sKey)
    Next
    On Error GoTo 0
End Sub

Function Dictionary_Transform(ByVal dOriginal, ByVal dFinal)
    ' Retunrs a dictionary with a list of update operations required
    ' so that dOriginal is transformed to dFinal

    Dim dTransform, sKey
    Set dTransform = CreateObject("Scripting.Dictionary")
    dTransform.CompareMode = vbTextCompare ' Case INsensitive

    For Each sKey In dFinal.Keys
        If Not dOriginal.Exists(sKey) Then
            dTransform.Add sKey, "ADD"
        End If
    Next

    For Each sKey In dOriginal.Keys
        If Not dFinal.Exists(sKey) Then
            dTransform.Add sKey, "DELETE"
        End If
    Next

    Set Dictionary_Transform = dTransform

End Function

' #endregion

' #region Active Directory object find routines

Function ADObject_Find_Generic(ByVal sObject, ByVal sSearchDN)
    ' Version 071130
    ' Takes any input (name, DN, or ADsPath) of a user, computer, or group, and
    ' returns the ADsPath of the object as a way of validating that the object exists
    '
    ' INPUTS:   sObject                 DN or ADsPath to an object
    '                                   sAMAccountName (pre-Windows 2000 logon name) of a user or group
    '                                   computer name of a computer
    '           sSearchDN               the DN within which to search (often, the DN of the domain, e.g. dc=contoso, dc=com)
    '
    ' RETURNS:  ADObject_Find_Generic   ADsPath (LDAP://...) of the object
    '                                   blank if object was not found
    '
    ' NOTES:    ASSUMPTION: computers, users & groups have unique names. See note inline.
    '
    ' REQUIRES  AD_Search_Array routine
    '           AD_Search_RS routine
    '           ADObject_Validate routine

    Dim aResults, sLDAPQuery
    Select Case ADObject_NameType(sObject)
        Case ""
            ADObject_Find_Generic = ""
        Case "adspath"
            ADObject_Find_Generic = ADObject_Validate(sObject)
        Case "distinguishedname"
            ADObject_Find_Generic = ADObject_Validate("LDAP://" & sObject)
        Case "name"
                ' Assumption: No computer has the same name as a user's or group's sAMAccountName
                ' otherwise, this query will return more than one result
                sLDAPQuery = "<LDAP://" & sSearchDN & ">;" & _
                             "(|(samAccountName=" & sObject & ")(samAccountName=" & sObject & "$));" & _
                             "aDSPath;subtree"
                aResults = AD_Search_Array (sLDAPQuery)
                If Ubound(aResults) = -1 Then
                    ADObject_Find_Generic = ""
                Else
                    ADObject_Find_Generic = aResults(0)
                End If
    End Select

End Function

Function ADObject_NameType(ByVal sObjectName)
    ' Version 071204
    ' Evaluates sObjectName to determine what type of name it is
    ' Returns   ADObject_NameType   adspath
    '                               distinguishedname
    '                               name
    '                               blank if sObjectName = ""

    Dim sNameType

    If Len(sObjectName) = 0 Then
        sNameType = ""

    ElseIf Len(sObjectName) < 3 Then
        ' can't be a DN or an ADsPath - must be a name
        sNameType = "name"

    ElseIf Ucase(Left(sObjectName,3)) = "CN=" Then
        ' is a DN
        sNameType = "distinguishedname"

    ElseIf Len(sObjectName) < 8 Then
        ' too short to be an ADsPath and isn't a DN, so it must be a name
        sNameType = "name"

    ElseIf UCase(Left(sObjectName, 7)) = "LDAP://" Then
        ' is already an ADsPath
        sNameType = "adspath"

    Else
        ' must be a name
        sNameType = "name"

    End If

    ADObject_NameType = sNameType
End Function

Function ADObject_Validate(ByVal sObjectADsPath)
    ' Version 071122
    ' Returns ADsPath of object as a way of validating that the object exists
    '
    ' INPUTS:   sObjectADsPath      ADsPath of object to test
    ' RETURNS:  ADObject_Validate   Path of object (if it exists) or blank

    Dim oObject
    On Error Resume Next
    Set oObject = GetObject(sObjectADsPath)
    If Err.Number <> 0 Then
        ADObject_Validate = ""
        Err

1 个答案:

答案 0 :(得分:0)

原来有两个答案要注意&#34; LDAP://&#34;凭证。

首先,特别是我发布的剧本,我只需要睁开眼睛! 几乎是脚本的最后一行,已经有了添加凭据的选项:

oConnection.Open "", vbNullString, vbNullString

只需要正确填充:

oConnection.Open "", "username", "password"

第二次,在这个答案中,@ Harvey Kwok已经提供了更为一般性的描述:Secure LDAP object manipulation with VBscript using alternate credentials