Programmierung zur Abfrage von 100000 Benutzern in AD

Question

Ich arbeite derzeit an einem Projekt, um AD abzufragen, ich habe ein Skript, das das tun, aber das Skript ist nach 1000 Benutzer fehlgeschlagen, während die Benutzer, die ich abzufragen ist rund 150.000 Benutzer.

Hier ist mein Code:

unten ist mein Skript, können Sie mich auf dem

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 

Die Variable von LDAP-Server-Linie sagen, LDAP Port, Benutzername, Passwort und Suchbasis sowohl für Benutzer und Gruppe wird über Anwendung eingegeben und es funktioniert so weit.

Fehler, was ich habe, ist, wenn es 1000 Benutzer erreicht:

Die Größenbegrenzung für diese Anforderung wurde überschritten.

Wenn ich die Zeile oDSRS.MoveNext entfernte, würde es einen "Überlauf" -Fehler geben.

Ich habe etwas gelesen und this ist die nächste, die ich mir vorstellen konnte.

Answer 1

Die administrativen LDAP-Beschränkungen gleichen die Betriebsfunktionen und die Leistung von Active Directory aus. Diese Grenzwerte verhindern, dass bestimmte Vorgänge die Leistung des Servers beeinträchtigen. Die Einschränkungen machen den Server auch für Denial-of-Service-Angriffe anfällig.

Als Teil der Grenzwerte gibt es eine MaxPageSize-Einstellung, die die Anzahl der Datensätze steuert, die für eine LDAP-Abfrage zurückgegeben werden können. Die Standardnummer ist 1.000 Datensätze und wenn Sie mehr als das haben, erhalten Sie eine Fehlermeldung "Das Größenlimit für diese Anfrage wurde überschritten".

Um Abhilfe zu schaffen, legen Sie die Option Seitengröße fest, die den Domänencontroller anweist, eine bestimmte Anzahl von Datensätzen zu verarbeiten und sie an den Client zurückzugeben, bevor die Suche fortgesetzt wird.

objCommand.Properties("Page Size") = 1000 

Dabei ist objCommand ein Name Ihres Befehlsobjekts.

Siehe vollständiges Beispiel here.