Posted By

RobertHirabayashi on 02/09/12


Tagged

windows domain directory active adodb ldap WMI RootDSE


Versions (?)

_Snippet-AllWindowsCrawler.vbs


 / Published in: Visual Basic
 

This script is a wrapper for delivering code to every computer object in a domain, and outputs the results to a time code stamped text or CSV file. Every computer is pinged to determine if it is up prior to running the payload, to prevent wasted time.

  1. '_Snippet-AllWindowsCrawler.vbs
  2.  
  3. On Error Resume Next
  4.  
  5. Call Payload()
  6.  
  7. WScript.Echo "Done"
  8.  
  9. '*****************************************************************************************************************************************************
  10.  
  11. Function Payload()
  12.  
  13. Set ofsout = CreateObject("Scripting.FileSystemObject")
  14. Set readout = ofsout.OpenTextFile("C:\VB Script\" & OutPutFileName("","csv"),2,true) ' Replace csv with desired file extention name
  15.  
  16. readout.writeline "CSV Header 1,CSV Header 2,CSV Header 3" ' Replace with field headers
  17.  
  18. On Error Resume Next
  19.  
  20. Const wbemFlagReturnImmediately=&h10
  21. Const wbemFlagForwardOnly=&h20
  22.  
  23. ' Determine DNS domain name from RootDSE object.
  24. Set objRootDSE = GetObject("LDAP://RootDSE")
  25. strDNSDomain = objRootDSE.Get("defaultNamingContext")
  26.  
  27. ' Use ADO to search Active Directory for all computers.
  28. Set adoCommand = CreateObject("ADODB.Command")
  29. Set adoConnection = CreateObject("ADODB.Connection")
  30. adoConnection.Provider = "ADsDSOObject"
  31. adoConnection.Open "Active Directory Provider"
  32. adoCommand.ActiveConnection = adoConnection
  33.  
  34. ' Search entire domain.
  35. strBase = "<LDAP://" & strDNSDomain & ">"
  36.  
  37. ' Filter on computer objects with server operating system.
  38. strFilter = "(&(objectCategory=computer))"
  39.  
  40. ' Comma delimited list of attribute values to retrieve.
  41. strAttributes = "cn"
  42.  
  43. ' Construct the LDAP syntax query.
  44. strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
  45.  
  46. adoCommand.CommandText = strQuery
  47. adoCommand.Properties("Page Size") = 100
  48. adoCommand.Properties("Timeout") = 30
  49. adoCommand.Properties("Cache Results") = False
  50.  
  51. Set adoRecordset = adoCommand.Execute
  52.  
  53. ' Enumerate computer objects with server operating systems.
  54. Do Until adoRecordset.EOF
  55. strComputer = adoRecordset.Fields("cn").Value
  56.  
  57. WScript.Echo "Checking if " & strComputer & " is alive..."
  58. If IsHostAlive(strComputer) = True Then
  59. Wscript.Echo "Processing: " & strComputer
  60.  
  61. Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
  62.  
  63. Set SWBemlocator = CreateObject("WbemScripting.SWbemLocator")
  64.  
  65. Set colItems = objWMIService.ExecQuery("Select * from ")
  66.  
  67. For Each objItem in colItems
  68. WScript.Echo strComputer & ": "
  69. readout.write strComputer & ","
  70.  
  71. '**********
  72.  
  73. 'Payload area
  74.  
  75. '**********
  76.  
  77. Next
  78.  
  79. 'Close queries
  80. Set SWBemlocator = Nothing
  81. Set objWMIService = Nothing
  82. Set colItems = Nothing
  83.  
  84. If (err.number <> 0)then
  85. error.clear
  86. End if
  87. Else
  88. wscript.echo "ERROR: " & strComputer & " cannot be reached or the account doesn't have proper permissions"
  89.  
  90. readout.writeline strComputer & " unreachable," & vbCrLf
  91. End If
  92.  
  93. adoRecordset.MoveNext
  94. Loop
  95.  
  96. ' Clean up.
  97. adoRecordset.Close
  98. adoConnection.Close
  99.  
  100. 'Close Files
  101. readout.close()
  102.  
  103. 'Function Complete
  104.  
  105. End Function
  106.  
  107. '*****************************************************************************************************************************************************
  108.  
  109. Function IsHostAlive(strComputer)
  110. IsHostAlive = False
  111.  
  112. On Error Resume Next
  113.  
  114. Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
  115.  
  116. Set colPings = objWMIService.ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address = '" & strComputer & "'")
  117.  
  118. Wscript.echo "Pinging " & strComputer & "..."
  119.  
  120. For Each colItems in colPings
  121. Select Case colItems.StatusCode
  122. Case 0 IsHostAlive = True
  123. Case 11001 wscript.echo "Buffer Too Small"
  124. Case 11002 wscript.echo "Destination Net Unreachable"
  125. Case 11003 wscript.echo "Destination Host Unreachable"
  126. Case 11004 wscript.echo "Destination Protocol Unreachable"
  127. Case 11005 wscript.echo "Destination Port Unreachable"
  128. Case 11006 wscript.echo "No Resources"
  129. Case 11007 wscript.echo "Bad Option"
  130. Case 11008 wscript.echo "Hardware Error"
  131. Case 11009 wscript.echo "Packet Too Big"
  132. Case 11010 wscript.echo "Request Timed Out"
  133. Case 11011 wscript.echo "Bad Request"
  134. Case 11012 wscript.echo "Bad Route"
  135. Case 11013 wscript.echo "TimeToLive Expired Transit"
  136. Case 11014 wscript.echo "TimeToLive Expired Reassembly"
  137. Case 11015 wscript.echo "Parameter Problem"
  138. Case 11016 wscript.echo "Source Quench"
  139. Case 11017 wscript.echo "Option Too Big"
  140. Case 11018 wscript.echo "Bad Destination"
  141. Case 11032 wscript.echo "Negotiating IPSEC"
  142. Case 11050 wscript.echo "General Failure"
  143. Case Else wscript.echo "Status code " & objPing.StatusCode & " - Unable to determine cause of failure."
  144. End Select
  145. Next
  146.  
  147. on error goto 0
  148. End Function
  149.  
  150.  
  151. Function OutPutFileName(ScriptFileName, fileEXT)
  152. strFileDate = Year(Now) & pd(Month(Now),2) & pd(Day(Now),2) & "-" & pd(Hour(Now),2) & pd(Minute(Now),2) & pd(Second(Now),2)
  153.  
  154. If ScriptFileName = "" Then
  155. ScriptFileName = Left(WScript.ScriptName, Len(WScript.ScriptName) - 4)
  156. End If
  157.  
  158. OutPutFileName = ScriptFileName & "_" & strFileDate & "." & fileEXT
  159.  
  160. End Function
  161.  
  162.  
  163. 'Pad single digit numbers with leading zero
  164. Function pd(n, totalDigits)
  165. if totalDigits > len(n) then
  166. pd = String(totalDigits-len(n),"0") & n
  167. else
  168. pd = n
  169. end if
  170. End Function
  171.  
  172. '*****************************************************************************************************************************************************

Report this snippet  

You need to login to post a comment.