我目前正在开发一个查询AD的项目，我有一个脚本可以做到这一点，但脚本在1000个用户后失败，而我查询的用户大约是150.000个用户。
这是我的代码：
下面是我的脚本，你能告诉我哪一行
Sub UserSynchQuery(ByRef res As APIResult, ByRef oRespDS As APIDataSet, ByRef sLDAPServer As String, ByRef sLDAPPort As String, ByRef sLDAPBase As String, ByRef sUserName As String, ByRef sPassword As String, ByRef sSLPPrimary As String, ByRef sSLPSecondary As String, ByRef sExtension As String, ByRef sConfiggroup As String, ByRef sFilter As String )
Trace( "Called UserSynchQuery Entered" )
Dim oDSP As Object
Dim oDSRS As Object
On Error Resume Next
Set oDSP = CreateObject("ADODB.Connection")
oDSP.Provider = "ADSDSOObject"
oDSP.Open( "Ads Provider", sUserName, Demung( sPassword ))
If Err.Number <> 0 Then
Trace("ERROR: Failed to instantiate ADO Object. " & Err.Number & " " & Err.Description)
res.Code = "FAILED"
res.Reason = "Failed to instantiate ADO Object"
Exit Sub
End If
On Error Goto 0
Dim sRoot 'Holds the root of the LDAP object
sRoot = "LDAP://" & sLDAPServer & ":" & sLDAPPort & "/" & sLDAPBase
Dim sQuery As String
Dim sSelect As String
sSelect = ADS_COLUMN_DN & "," & ADS_COLUMN_USERNAME & "," & ADS_COLUMN_LASTNAME & "," & ADS_COLUMN_FIRSTNAME & "," & ADS_COLUMN_EMAIL & ","
If Len(sSLPPrimary) > 0 Then
sSelect = sSelect & sSLPPrimary & ","
End If
If Len(sSLPSecondary) > 0 Then
sSelect = sSelect & sSLPSecondary & ","
End If
If Len(sExtension) > 0 Then
sSelect = sSelect & sExtension & ","
End If
If Len(sConfiggroup) > 0 Then
sSelect = sSelect & sConfiggroup & ","
End If
sSelect = sSelect & ADS_COLUMN_MEMBEROF
sQuery = "SELECT " & sSelect & " FROM '" & sRoot & "' WHERE " & sFilter
Trace( "Query String: " & sQuery )
On Error Resume Next
Set oDSRS = oDSP.Execute(sQuery)
If Err.Number <> 0 Then
Trace("ERROR: Query Failed. " & Err.Number & " " & Err.Description)
res.Code = "FAILED"
res.Reason = "Query Failed"
Exit Sub
End If
On Error Goto 0
'// before you can fill in the dataset, you must initialize it with the
'// number of columns
oRespDS.Initialize(MSG_USER_QUERY_RESP_NUM_COLS)
Dim nRow
Dim sRSUserName
Dim sRSLastName
Dim sRSFirstName
Dim sRSEmail
Dim sRSDN
Dim sRSSLPPrimary
Dim sRSSLPSecondary
Dim sRSExtension
Dim sRSConfiggroup
nRow = 0
Do Until oDSRS.EOF
sRSUserName = oDSRS.Fields(ADS_COLUMN_USERNAME).Value
sRSLastName = oDSRS.Fields(ADS_COLUMN_LASTNAME).Value
sRSFirstName = oDSRS.Fields(ADS_COLUMN_FIRSTNAME).Value
sRSEmail = oDSRS.Fields(ADS_COLUMN_EMAIL).Value
sRSDN = oDSRS.Fields(ADS_COLUMN_DN).Value
Trace("----------- Found User -----------")
Trace("Username: " & sRSUserName)
Trace("Last Name: " & sRSLastName)
Trace("First Name: " & sRSFirstName)
Trace("Email: " & sRSEmail)
Trace("DN: " & sRSDN)
If Len(sSLPPrimary) > 0 Then
sRSSLPPrimary = oDSRS.Fields(sSLPPrimary).Value
Trace("sSLPPrimary: " & sRSSLPPrimary)
End If
If Len(sSLPSecondary) > 0 Then
sRSSLPSecondary = oDSRS.Fields(sSLPSecondary).Value
Trace("sSLPSecondary: " & sRSSLPSecondary)
End If
If Len(sExtension) > 0 Then
sRSExtension = oDSRS.Fields(sExtension).Value
Trace("sExtension: " & sRSExtension)
End If
If Len(sConfiggroup) > 0 Then
sRSConfiggroup = oDSRS.Fields(sConfiggroup).Value
Trace("sConfiggroup: " & sRSConfiggroup)
End If
If( IsNull( sRSUserNamme ) Or IsNull( sRSLastName ) Or IsNull( sRSFirstName ) Or IsNull( sRSDN ) ) Then
Trace( "Error: Ignoring user due to missing information" )
Else
'We need to build up the list of groups which needs
'to include any indirect group membership which could
'be the result of assigning a group to be a member of
'another group.
Dim arrGroups
Dim dictGroupNamesByDN
Set dictGroupNamesByDN = CreateObject("Scripting.Dictionary")
arrGroups = oDSRS.Fields(ADS_COLUMN_MEMBEROF).Value
if IsNull( arrGroups ) Then
Trace("--->No groups found")
Else
ProcessGroupMembership( dictGroupNamesByDN, arrGroups )
End If
'Now assing the roles to the user based on
'the nested groups that we just retrieved.
Dim sApplications As String
sApplications = ""
'We also use this opportunity to build the
'workgroup membership up.
Dim sWorkgroup As String
sWorkgroups = ""
Dim sCN As String
Dim sDN As String
Dim keys
keys = dictGroupNamesByDN.Keys
For Each key in keys
sDN = key
sCN = dictGroupNamesByDN.Item(key)
sWorkgroups = sWorkgroups & sCN & ";"
If sCN = CIM_AGENT_APPLICATION_GROUP_NAME Then
sApplications = sApplications & "AGENT;"
End If
If sCN = CIM_RESMAN_APPLICATION_GROUP_NAME Then
sApplications = sApplications & "RESMAN;"
End If
If sCN = CIM_CONFIGMAN_APPLICATION_GROUP_NAME Then
sApplications = sApplications & "CONMAN;"
End If
If sCN = CIM_IVAULT_APPLICATION_GROUP_NAME Then
sApplications = sApplications & "IVAULT;"
End If
If sCN = CIM_DECMAN_APPLICATION_GROUP_NAME Then
sApplications = sApplications & "DMWEB;"
End If
If sCN = CIM_QIM_APPLICATION_GROUP_NAME Then
sApplications = sApplications & "QIM;"
End If
If sCN = CIM_SYSMAN_APPLICATION_GROUP_NAME Then
sApplications = sApplications & "SYSMAN;"
End If
Next
Trace("Roles: " & sApplications)
Trace("Workgroups: " & sWorkgroups)
oRespDS.AddRow
oRespDS.SetField(nRow,MSG_USER_QUERY_RESP_USERNAME, sRSUserName)
oRespDS.SetField(nRow,MSG_USER_QUERY_RESP_LASTNAME, sRSLastName)
oRespDS.SetField(nRow,MSG_USER_QUERY_RESP_FIRSTNAME, sRSFirstName)
If Not IsNull(sRSEMail) Then
oRespDS.SetField(nRow,MSG_USER_QUERY_RESP_EMAIL, sRSEmail)
End If
oRespDS.SetField(nRow,MSG_USER_QUERY_RESP_DN, sRSDN)
oRespDS.SetField(nRow,MSG_USER_QUERY_RESP_APPLICATIONS, sApplications)
oRespDS.SetField(nRow,MSG_USER_QUERY_RESP_WORKGROUPS, sWorkgroups)
If Len(sSLPPrimary) > 0 Then
If IsNull( sRSSLPPrimary ) Then
Trace("Warning: " & sSLPPrimary & " value not populated")
Else
oRespDS.SetField(nRow,MSG_USER_QUERY_RESP_SLPPRIMARY, sRSSLPPrimary)
End If
End If
If Len(sSLPSecondary) > 0 Then
If IsNull( sRSSLPSecondary ) Then
Trace("Warning: " & sSLPSecondary & " value not populated")
Else
oRespDS.SetField(nRow,MSG_USER_QUERY_RESP_SLPSECONDARY, sRSSLPSecondary)
End If
End If
If Len(sExtension) > 0 Then
If IsNull( sRSExtension ) Then
Trace("Warning: " & sExtension & " value not populated")
Else
oRespDS.SetField(nRow,MSG_USER_QUERY_RESP_EXTENSION, sRSExtension)
End If
End If
If Len(sConfiggroup) > 0 Then
If IsNull( sRSConfiggroup ) Then
Trace("Warning: " & sConfiggroup & " value not populated")
Else
oRespDS.SetField(nRow,MSG_USER_QUERY_RESP_CONFIGGROUPS, sRSConfiggroup)
End If
End If
nRow = nRow + 1
End If
oDSRS.MoveNext
Loop
'Clean up
On Error Resume Next
oDSP = Nothing
oDSRS = Nothing
On Error Goto 0
End Sub
用户和组的LDAP SERVER，LDAP PORT，用户名，密码和搜索库的变量都是通过应用程序输入的，到目前为止一直在运行。
错误我拥有的是一旦达到1000个用户：
超出了此请求的大小限制。
如果我删除了行oDSRS.MoveNext，则会出现“溢出”错误。
我做了一些阅读，this是我能想到的最接近的。
答案 0 :(得分：0)
LDAP管理限制可以平衡Active Directory的操作功能和性能。这些限制可防止特定操作对服务器性能产生负面影响。这些限制还使服务器能够抵御拒绝服务攻击。
作为限制的一部分，有一个MaxPageSize设置，用于控制可以为LDAP查询返回的记录数。默认数量为1,000条记录，如果您有多条记录，则会收到错误“超出此请求的大小限制”。
要解决此问题，请设置“页面大小”选项，该选项指示域控制器处理一定数量的记录并将其返回给客户端，然后再继续搜索。
objCommand.Properties("Page Size") = 1000
其中objCommand是Command对象的名称。
请参阅完整示例here。