_Snippet-AllWindowsCrawler.vbs

'_Snippet-AllWindowsCrawler.vbs
 
On Error Resume Next
 
Call Payload()
 
WScript.Echo "Done"
 
'*****************************************************************************************************************************************************
 
Function Payload()
 
Set ofsout = CreateObject("Scripting.FileSystemObject")
Set readout = ofsout.OpenTextFile("C:\VB Script\" & OutPutFileName("","csv"),2,true) ' Replace csv with desired file extention name
 
readout.writeline "CSV Header 1,CSV Header 2,CSV Header 3"  ' Replace with field headers
 
On Error Resume Next
 
Const wbemFlagReturnImmediately=&h10
Const wbemFlagForwardOnly=&h20
 
' Determine DNS domain name from RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
 
' Use ADO to search Active Directory for all computers.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
 
' Search entire domain.
strBase = "<LDAP://" & strDNSDomain & ">"
 
' Filter on computer objects with server operating system.
strFilter = "(&(objectCategory=computer))"
 
' Comma delimited list of attribute values to retrieve.
strAttributes = "cn"
 
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
 
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
 
Set adoRecordset = adoCommand.Execute
 
' Enumerate computer objects with server operating systems.
Do Until adoRecordset.EOF
	strComputer = adoRecordset.Fields("cn").Value
 
	WScript.Echo "Checking if " & strComputer & " is alive..."
	If IsHostAlive(strComputer) = True Then
		Wscript.Echo "Processing: " & strComputer
 
		Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
 
		Set SWBemlocator = CreateObject("WbemScripting.SWbemLocator")
 
		Set colItems = objWMIService.ExecQuery("Select * from ")
 
		For Each objItem in colItems
			WScript.Echo strComputer & ": "
      readout.write strComputer & ","
 
'**********
 
'Payload area
 
'**********
 
		Next
 
		'Close queries
		Set SWBemlocator = Nothing
		Set objWMIService = Nothing
		Set colItems = Nothing
 
		If (err.number <> 0)then
			error.clear
		End if
	Else
		wscript.echo "ERROR: " & strComputer & " cannot be reached or the account doesn't have proper permissions"
 
    readout.writeline strComputer & " unreachable," & vbCrLf
	End If
 
	adoRecordset.MoveNext
Loop
 
' Clean up.
adoRecordset.Close
adoConnection.Close
 
'Close Files
readout.close()
 
'Function Complete
 
End Function
 
'*****************************************************************************************************************************************************
 
Function IsHostAlive(strComputer)
	IsHostAlive = False
 
	On Error Resume Next
 
  Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
 
  Set colPings = objWMIService.ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address = '" & strComputer & "'")
 
  Wscript.echo "Pinging " & strComputer & "..."
 
  For Each colItems in colPings
  	Select Case colItems.StatusCode
    	Case 0 IsHostAlive = True
      Case 11001 wscript.echo "Buffer Too Small"
      Case 11002 wscript.echo "Destination Net Unreachable"
      Case 11003 wscript.echo "Destination Host Unreachable"
      Case 11004 wscript.echo "Destination Protocol Unreachable"
      Case 11005 wscript.echo "Destination Port Unreachable"
      Case 11006 wscript.echo "No Resources"
			Case 11007 wscript.echo "Bad Option"
      Case 11008 wscript.echo "Hardware Error"
      Case 11009 wscript.echo "Packet Too Big"
      Case 11010 wscript.echo "Request Timed Out"
      Case 11011 wscript.echo "Bad Request"
      Case 11012 wscript.echo "Bad Route"
      Case 11013 wscript.echo "TimeToLive Expired Transit"
      Case 11014 wscript.echo "TimeToLive Expired Reassembly"
      Case 11015 wscript.echo "Parameter Problem"
      Case 11016 wscript.echo "Source Quench"
      Case 11017 wscript.echo "Option Too Big"
      Case 11018 wscript.echo "Bad Destination"
      Case 11032 wscript.echo "Negotiating IPSEC"
      Case 11050 wscript.echo "General Failure"
      Case Else wscript.echo "Status code " & objPing.StatusCode & " - Unable to determine cause of failure."
    End Select
  Next
 
 	on error goto 0
End Function
 
 
Function OutPutFileName(ScriptFileName, fileEXT)
   strFileDate = Year(Now) & pd(Month(Now),2) & pd(Day(Now),2) & "-" & pd(Hour(Now),2) & pd(Minute(Now),2) & pd(Second(Now),2)
 
  If ScriptFileName = "" Then
  	ScriptFileName = Left(WScript.ScriptName, Len(WScript.ScriptName) - 4)
  End If
 
OutPutFileName = ScriptFileName & "_" & strFileDate & "." & fileEXT
 
End Function
 
 
'Pad single digit numbers with leading zero
Function pd(n, totalDigits)
   if totalDigits > len(n) then
      pd = String(totalDigits-len(n),"0") & n
   else
      pd = n
   end if
End Function
 
'*****************************************************************************************************************************************************