Copy below script into notepad and save as ScanServersDesktops.vbs file, this
will scan the domain servers/desktops or both and result will be in
C;\ComputerReport.csv
====================================================================================
Option Explicit
Call
MainScript
WScript.Echo "Changes complete. Check the report on C:
Drive"
Sub MainScript
' Version 1.0
' Amended by Krystian Karia
' Dated 18-Feb-2009
' Script that gets all the computer names
' and their DistinguishedNames from AD.
' All results are put to a csv file
On
Error Resume Next
Dim
objFSO, objReport
Dim
strReportFile
Dim
strHeader, strMsg
Dim
strComputer
Dim
iSelectedOption
Dim
arrComputers
Const
ForWriting = 2
' Create needed objects
Set
objFSO = CreateObject("Scripting.FileSystemObject")
' Initialize variables
strHeader
= "ComputerName,DistinguishedName"
strReportFile
= "c:\ComputerReport.csv"
' Open the report
Set
objReport = objFSO.OpenTextFile(strReportFile, ForWriting, True)
' Enter the header
objReport.WriteLine
strHeader
' Ask where to get our machine list from
strMsg
= strMsg & "Select an option by entering a number only!" &
vbNewLine & vbNewLine
strMsg
= strMsg & "1 - Servers Only (From AD)" & vbNewLine
strMsg
= strMsg & "2 - Desktops Only (From AD)" & vbNewLine
strMsg
= strMsg & "3 - All Machines (From AD)" & vbNewLine &
vbNewLine
iSelectedOption
= InputBox(strMsg, "Select an Option", "1")
Select
Case Trim(iSelectedOption)
Case
"1"
arrComputers
= GetObjectArrayFromAD("Servers", "")
Case
"2"
arrComputers
= GetObjectArrayFromAD("Desktops", "")
Case
"3"
arrComputers
= GetObjectArrayFromAD("AllMachines", "")
Case
Else
WScript.Echo
"An invalid option was made or you cancelled"
WScript.Quit
End
Select
' Loop each computer
For
Each strComputer In arrComputers
If
strComputer = "" Then
Exit
For
End
If
objReport.WriteLine
strComputer
Next
objReport.Close
End Sub
Private Function GetObjectArrayFromAD(sArgComputerType,
sArgDCName)
' Version 1.0
'
~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~
' Function
Written by Krystian Karia
' Description: Function that searches AD based on the
criteria
' that
you pass to it and returns an Array
' Use: Pass the
Machine Type and optional Domain Controller ServerName
' Example: arrMyComputerArray
= GetObjectArrayFromAD("servers" | "desktops" |
"allmachines" ["dcservername"])
' Returns: An array of all required
computer objects found
' Version: Version 1.0 Created on 06-08-2007
'
~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~¬~
On
Error Resume Next
Dim
oRoot
Dim
strBase, strFilter, strCriteria, strLevel
Dim
adoConnection, adoCommand, adoRecordset
Dim
strQuery, strContents
Dim
arrResults
Dim i
' Get the Domain you are currently in
Set
oRoot = GetObject("LDAP://rootDSE")
strBase
= oRoot.Get("defaultNamingContext")
If
Err.Number<> 0 Then
WScript.Echo
"Unable to get the current domain name - Is the machine this script ran on
a part of one?" _
&
VbCrLf & "Error: " & Err.Number _
&
VbCrLf & Err.Source _
&
VbCrLf & Err.Description
Err.Clear
GetObjectArrayFromAD
= False
End
If
' Build the Filter string according to our computer type
request
Select
Case UCase(sArgComputerType)
Case
"SERVERS"
strFilter
=
"(&(&(&(sAMAccountType=805306369)(objectCategory=computer)(operatingSystem=*Server*))))"
Case
"DESKTOPS"
strFilter
=
"(&(&(sAMAccountType=805306369)(objectCategory=computer)(!operatingSystem=*Server*)))"
Case
"ALLMACHINES"
strFilter
=
"(&(&(&(sAMAccountType=805306369)(objectCategory=computer)(samAccountName=*))))"
Case
Else
Exit
Function
End
Select
' Set our Attribute Criteria and Search Level
strCriteria
= "sAMAccountName,distinguishedName"
strLevel =
"SubTree"
' Build our complete query string using the DC Server Name
if passed
If
sArgDCName <> "" Then
strQuery
= "<LDAP://" & sArgDCName & "/" & strBase
& ">;" & strFilter & ";" & strCriteria
& ";" & strLevel
Else
strQuery
= "<LDAP://" & strBase & ">;" & strFilter
& ";" & strCriteria & ";" & strLevel
End If
' Set up the connection to Active Directory using ADO
Set
adoConnection = CreateObject("ADODB.Connection")
Set
adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider
= "ADsDSOObject"
adoConnection.Open
= "Active Directory Provider"
adoConnection.Cursorlocation
= 3
Set
adoCommand.ActiveConnection = adoConnection
If
Err.Number <> 0 Then
WScript.Echo
"Unable to open a connection to Active Directory" _
&
VbCrLf & "Error: " & Err.Number _
&
VbCrLf & Err.Source _
&
VbCrLf & Err.Description
Err.Clear
GetObjectArrayFromAD
= False
End
If
adoCommand.CommandText
= strQuery
adoCommand.Properties("Page
Size") = 1000
adoCommand.Properties("Timeout")
= 30
adoCommand.Properties("Cache
Results") = False
' Get the recordset results of the query to Active Directory
Set
adoRecordset = adoCommand.Execute
adoRecordset.Sort
= "distinguishedName"
If
Err.Number <> 0 Then
WScript.Echo
"An error occured executing the recordset" _
&
VbCrLf & "Error: " & Err.Number _
&
VbCrLf & Err.Source _
&
VbCrLf & Err.Description
Err.Clear
GetObjectArrayFromAD
= False
End
If
' Loop all the records that were found
Do
Until adoRecordset.EOF = True
' For
i = 0 To adoRecordset.Fields.Count - 1
If
NOT IsNull(adoRecordset.Fields("sAMAccountName").Value) Then ' Remove
$ symbol from end of machines
strContents
= strContents & Left(adoRecordset.Fields("sAMAccountName").Value,
Len(adoRecordset.Fields("sAMAccountName").Value) - 1) &
","
End
If
strContents
= strContents & Chr(34) &
adoRecordset.Fields("distinguishedName").Value & Chr(34) &
vbNewLine
' Next
adoRecordset.MoveNext
Loop
' Close the Recordset and clear the variables
adoConnection.Close
Set
adoRecordset = Nothing
Set
adoCommand = Nothing
Set
adoConnection = Nothing
' Check the contents of the list is not empty
If
Trim(strContents) <> "" Then
arrResults
= Split(strContents, vbNewLine) '
Create an array of the list
strContents
= "" '
Clear the variable as not needed anymore
Err.Clear
GetObjectArrayFromAD
= arrResults
Else
Err.Clear
GetObjectArrayFromAD
= False
End
If
End Function 'GetObjectArrayFromAD
=====================================================================================
No comments:
Post a Comment