编程查询AD中的100000个用户

Question

我目前正在研究一个项目来查询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服务器的变量LDAP端口，用户名，密码和搜索基地既为用户并且组通过应用程序进入并且它工作到目前为止。

错误我有什么是一旦达到1000个用户：

为此请求大小限制超出。

如果我删除了行oDSRS.MoveNext它会给出一个“溢出”错误。

我做了一些阅读，this是我能想出的最接近的。

Answer 1

LDAP管理限制平衡Active Directory的操作功能和性能。这些限制可防止特定操作对服务器的性能造成不利影响。这些限制还使服务器对拒绝服务攻击具有适应能力。

作为限制的一部分，有一个MaxPageSize设置控制可以为LDAP查询返回的记录数。默认数量是1,000条记录，如果您的数量超过了此数量，则会出现错误“超出此请求的大小限制”。

要解决该问题，请设置页面大小选项，该选项指示域控制器在继续搜索之前处理一定数量的记录并将其返回给客户端。

objCommand.Properties("Page Size") = 1000 

其中objCommand是Command对象的名称。

查看完整示例here。