编程以在AD中查询100000个用户

时间:2016-07-25 18:12:49

标签: vba active-directory

我目前正在开发一个查询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是我能想到的最接近的。

1 个答案:

答案 0 :(得分:0)

LDAP管理限制可以平衡Active Directory的操作功能和性能。这些限制可防止特定操作对服务器性能产生负面影响。这些限制还使服务器能够抵御拒绝服务攻击。

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

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

objCommand.Properties("Page Size") = 1000

其中objCommand是Command对象的名称。

请参阅完整示例here