LDAP Query with VBScript limiting to 1000 records

[cumpleby]

I have the following VBSCript that is doing an LDAP query but is only pulling back 1000 records, can somebody please explain why:-

' VB Script Document
Option Explicit
On Error Resume Next

WScript.Echo "Beginning Script Execution: " & Now

Dim objWMIService, objItem, objDom, objProvider, objConnection, objRecordSet, objCommand
Dim objWMIPinger, objWMIPingStatus, objStatus, objFile, objFSO, objDictionary, oPing
Dim strComputer, strWMIns, strWMIQuery, strQuery, strTarget, strUsername, strLen, strIPaddress
Dim colItems
Dim intStatus, i
Dim arrKeys, arrItems
Dim PingAddress

Const ForWriting = 2
Const ForReading = 1
Const ForAppending = 8
Const DISABLED = 514
Const ACTIVE = 512

objProvider = "'LDAP://"
objDom = "DC=domain, DC=com'"
strQuery = "SELECT Name, distinguishedName, userAccountControl, adsPath FROM 'LDAP://DC=domain, DC=com' WHERE objectCategory='computer' ORDER BY Name"
'strQuery = "Select name, distinguishedName, userAccountControl from '" & objProvider & objDom & "' WHERE objectCategory='computer'"

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Open "Provider=ADsDSOObject;"
objCommand.ActiveConnection = objConnection
objCommand.CommandText = strQuery
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Size Limit") = 2000
objCommand.Properties("Searchscope") = 2

Set objRecordSet = objCommand.Execute

Set objDictionary = CreateObject("Scripting.Dictionary")


Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists("c:\scripts\usermac.xml") Then
objFSO.DeleteFile("usermac.xml")
Set objFile = objFSO.CreateTextFile("c:\scripts\usermac.xml", True)
objFile.Close
startFile ' Called by a sub
Else
Set objFile = objFSO.CreateTextFile("c:\scripts\usermac.xml", True)
objFile.Close
startFile ' Called by a sub
End If

While Not objRecordSet.EOF ' Remember to objRecordSet.MoveNext before Wend
'WScript.Echo objRecordSet.Fields("userAccountControl").Value
If objRecordSet.Fields("userAccountControl").Value <> 4098 Then
strTarget = objRecordSet.Fields("name")
strWMIns = "\root\cimv2"
strWMIQuery = "SELECT * FROM Win32_ComputerSystem"
WScript.Echo "Processing " & strTarget

If Ping(strTarget) = False Then
strComputer = LCase(strTarget) & ".domain.com"
intStatus = 0
strUsername = "nobody"
strIPaddress = "0.0.0.0"
'Set objWMIPinger = Nothing
'Set objWMIPingStatus = Nothing
Else
'If strTarget <> "SRV0010" Then
Set objWMIService = GetObject("winmgmts:\\" & strTarget & strWMIns)
Set colItems = objWMIService.ExecQuery(strWMIQuery)

If colItems.Count = 0 Then
strComputer = LCase(strTarget) & ".domain.com"
intStatus = 0
strUsername = "nobody"
strIPaddress = PingAddress
Else
strComputer = LCase(strTarget) & ".domain.com"
intStatus = 1
strIPaddress = PingAddress
For Each objItem in colItems
If IsNull(objItem.Username) Then
strUsername = "nobody"
Else
strLen = Len(objItem.Username) - 0
strUsername = LCase(Right(objItem.Username,Len(objItem.Username) - 0))
End If
Next
End If

Set objWMIService = Nothing
Set colItems = Nothing
'End If
End If

objDictionary.Add "name", strComputer
objDictionary.Add "status", intStatus
objDictionary.Add "username", strUsername
objDictionary.Add "ipaddress", strIPaddress
arrKeys = objDictionary.Keys
arrItems = objDictionary.Items
writeXML arrKeys, arrItems
objDictionary.RemoveAll
End If
objRecordSet.MoveNext
Wend

closeFile
objFile.Close
objFSO.CopyFile "c:\scripts\usermac.xml", "D:\Websites\systems.minsterlaw.co.uk\xml\", True
WScript.Echo "Ended: " & Now


Sub startFile
Set objFile = objFSO.OpenTextFile("c:\scripts\usermac.xml", ForAppending)
objFile.WriteLine "<?xml version=""1.0"" encoding=""ISO-8859-1""?>"
objFile.WriteLine "<?xml-stylesheet type=""text/xsl"" href=""c:\scripts\usermac.xsl""?>"
objFile.WriteLine "<computerlist>"
End Sub

Sub closeFile
objFile.WriteLine "</computerlist>"
End Sub

Sub writeXML(arrKeys, arrItems)
objFile.WriteLine vbTab & "<computer>"
For i = 0 To UBound(arrKeys)
objFile.WriteLine vbTab & vbTab & "<" & arrKeys(i) & ">" & arrItems(i) & "</" & arrKeys(i) & ">"
Next
objFile.WriteLine vbTab & "</computer>"
End Sub

Function Ping(strTarget)

Set objWMIPinger = GetObject("winmgmts:\\.\root\cimv2")
Set objWMIPingStatus = objWMIPinger.ExecQuery("Select * from Win32_PingStatus where Address='" & strTarget & "'")

For Each oPing In objWMIPingStatus
If IsNull(oPing.StatusCode) Or oPing.StatusCode <> 0 Then
Ping = False
PingAddress = oPing.ProtocolAddress
Else
Ping = True
PingAddress = oPing.ProtocolAddress
End If
Next
End Function

 

[BobRodes]

Hmm. I noticed this line here: [tt]objCommand.Properties("Page Size") = 1000[/tt]. Suspicious that it might mean that only 1000 records might be returned, I googled "objcommand.properties page size 1000" and came upon this:

http://blogs.technet.com/b/heyscrip...-t-my-search-return-all-my-user-accounts.aspx

. I don't suppose it has to do with your problem?

An unforeseen consequence of the information revolution has been the exponential propagation of human error.

 

[strongm]

Are you saying that if you change

Set objRecordSet = objCommand.Execute

to

Set objRecordSet = objCommand.Execute
WScript.echo objRecordset.RecordCount

you get a value of only 1000 (and you expect more)?




(note, by the way, that in future you will probably be better off asking such questions in forum329 rather than in this one)