如何向 "LDAP://" 提供主机名和凭据？
How to provide hostname and credentials to "LDAP://"?
我需要一个基于多个 DN 的 Active Directory 影子组（也称为 Active Directory 动态组）。
我到处搜索可以让我执行此操作的简单工具，最后在 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
关于 "LDAP://" 凭证，有两个答案需要注意。
首先，具体到我发的脚本，简直要开眼了！
几乎脚本的最后一行已经有添加凭据的选项：
oConnection.Open "", vbNullString, vbNullString
只需正确填充：
oConnection.Open "", "username", "password"
Second，@Harvey Kwok 已经在这个 SO 答案中提供了更一般的描述：Secure LDAP object manipulation with VBscript using alternate credentials
我需要一个基于多个 DN 的 Active Directory 影子组（也称为 Active Directory 动态组）。
我到处搜索可以让我执行此操作的简单工具，最后在 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
关于 "LDAP://" 凭证，有两个答案需要注意。
首先，具体到我发的脚本，简直要开眼了！ 几乎脚本的最后一行已经有添加凭据的选项：
oConnection.Open "", vbNullString, vbNullString
只需正确填充：
oConnection.Open "", "username", "password"
Second，@Harvey Kwok 已经在这个 SO 答案中提供了更一般的描述：Secure LDAP object manipulation with VBscript using alternate credentials