Option Explicit

Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20

Dim logpath, objFSO, strDom, strPSPath, f1, arr1, intRow, objXL, strService1
Dim strCompName, strReachable, strOS, strSP, strMan, strMod, strDC
Dim strDHCP, strClusNode, arr2, strService, AllInstalledSoftware
Dim objWMIService, colItems, objItem, tmpVar1, tmpVar2, tmpVar3, strWINS
Dim pos1, pos2, i, j, strRawOutput, strDNS, strSN, pstoolsPath, apps

logpath = GetPath()

'your domain below
strDom = "DC=ACME,DC=COM"
pstoolsPath = "c:\Tools\pstools"

' Create Excel file
intRow = 1 
Set objXL = Wscript.CreateObject("Excel.Application") 
objXL.Visible = True 
objXL.WorkBooks.Add
objXL.Sheets("Sheet1").Select()
objXL.Sheets("Sheet1").Name = "Server Inventory"
objXL.Columns(1).ColumnWidth = 15 'ServerName
objXL.Columns(2).ColumnWidth = 9 'Online
objXL.Columns(3).ColumnWidth = 20 'OS
objXL.Columns(4).ColumnWidth = 12 'SP
objXL.Columns(5).ColumnWidth = 12 'Manufacturer
objXL.Columns(6).ColumnWidth = 12 'Model
objXL.Columns(7).ColumnWidth = 12 'SerialNumber
objXL.Columns(8).ColumnWidth = 10 'DC
objXL.Columns(9).ColumnWidth = 10 'DNS
objXL.Columns(10).ColumnWidth = 10 'DHCP
objXL.Columns(11).ColumnWidth = 10 'WINS
objXL.Columns(12).ColumnWidth = 10 'ClusterNode
objXL.Columns(13).ColumnWidth = 10 'Exchange
objXL.Columns(14).ColumnWidth = 50 'Applications
objXL.Columns(15).ColumnWidth = 12 'WMI Status
objXL.Range("A1:O1").Select 
objXL.Selection.Font.Bold = True
objXL.Selection.Font.Size = 8 
objXL.Selection.Interior.ColorIndex = 11 
objXL.Selection.Interior.Pattern = 1 'xlSolid 
objXL.Selection.Font.ColorIndex = 2 
objXL.Selection.WrapText = True 
objXL.Columns("A:X").Select 
objXL.Selection.HorizontalAlignment = 3 'xlCenter
objXL.Selection.WrapText = True 

' Populate header row
objXL.Cells(intRow, 1).Value = "ServerName"
objXL.Cells(intRow, 2).Value = "Online"
objXL.Cells(intRow, 3).Value = "OS"
objXL.Cells(intRow, 4).Value = "SP"
objXL.Cells(intRow, 5).Value = "Manufacturer" 
objXL.Cells(intRow, 6).Value = "Model"
objXL.Cells(intRow, 7).Value = "SerialNumber"
objXL.Cells(intRow, 8).Value = "DC"
objXL.Cells(intRow, 9).Value = "DNS"
objXL.Cells(intRow, 10).Value = "DHCP"
objXL.Cells(intRow, 11).Value = "WINS"
objXL.Cells(intRow, 12).Value = "ClusterNode"
objXL.Cells(intRow, 13).Value = "Exchange"
objXL.Cells(intRow, 14).Value = "Applications"
objXL.Cells(intRow, 15).Value = "WMI Status"
objXL.Cells(1, 1).Select

intRow = intRow + 1

arr1 =  FindAllServersInDomain(strDom)

For i = 0 To UBound(arr1)
	strCompName = ucase(trim(arr1(i)))
	wscript.echo "Working on " & strCompName & ", number " & i + 1 & _
		" in the list."
	objXL.Cells(intRow, 1).Value = strCompName
	'Is server ping-able?"
	If Reachable(strCompName) then
		objXL.Cells(intRow, 2).Value = "Online"
		' Get app data and format to insert into spreadsheet
		strRawOutput = ExecCmd("%comspec% /c " & pstoolsPath & _
			"\psinfo applications -s \\" & strCompName)
		If strRawOutput <> "" then
			If instr(1, strRawOutput, "Access is denied.", 1) = 0 then
				If instr(1, strRawOutput, _
				"The network path was not found.", 1) = 0 then
					pos1 = Instr(1, strRawOutput, "Applications:", 1)
					pos2 = Instr(1, strRawOutput, "PSInfo v1.75", 1)
					tmpVar1 = Replace(Mid(strRawOutput, pos1 + 15, _
						pos2 - (pos1 + 17)), vbcrlf, ";", 1, -1, 1)
					tmpVar2 = Split(tmpVar1, ";", -1, 1)
					For j = 0 To UBound(tmpVar2)
						If InStr(1, tmpVar2(j), _
						"Security Update", 1) = 0 then
							If InStr(1, tmpVar2(j), _
							"Update for Windows", 1) = 0 then
								If InStr(1, tmpVar2(j), _
								"Hotfix", 1) = 0 then
									tmpVar3 = tmpVar3 & _
									tmpVar2(j) & "; "
								End If
							End If
						End If
					Next
					apps = Left(tmpVar3, Len(tmpVar3) - 2)
					objXL.Cells(intRow, 14).Value = apps
				Else
					objXL.Cells(intRow, 14).Value = _
						"The network path was not found."
				End If
			Else
				objXL.Cells(intRow, 14).Value = "Access is denied."
			End If
		End If
		' Set up WMI Connection
		On Error Resume Next
		err.clear
		Set objWMIService = GetObject("winmgmts:\\" & strCompName & "\root\CIMV2")
		If err.number = 0 then
			objXL.Cells(intRow, 15).Value = "Successfully connected to WMI"
			' Get serial number
			Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_BIOS",,48)
			For Each objItem In colItems
				strSN = objItem.SerialNumber
			Next
			If strSN <> "" OR strSN <> NULL then
				objXL.Cells(intRow, 7).Value = strSN
			End If
			Set colItems = Nothing
			Set objItem = Nothing
			' Dumping OS info
			Set colItems = objWMIService.ExecQuery _
				("SELECT Caption, CSDVersion FROM Win32_OperatingSystem", _
				"WQL", wbemFlagReturnImmediately + wbemFlagForwardOnly)
			For Each objItem In colItems
				strOS = objItem.Caption
				strSP = objItem.CSDVersion
			Next
			If strOS <> "" OR strOS <> NULL then
				objXL.Cells(intRow, 3).Value = strOS
			End If
			If strSP <> "" OR strSP <> NULL then
				objXL.Cells(intRow, 4).Value = strSP
			End If 
			Set colItems = Nothing
			Set objItem = Nothing
			' Dumping Make/Model
			Set colItems = objWMIService.ExecQuery _
				("SELECT Manufacturer, Model FROM Win32_ComputerSystem", "WQL", _
				wbemFlagReturnImmediately + wbemFlagForwardOnly)
			For Each objItem In colItems
				strMan = trim(objItem.Manufacturer)
				strMod = trim(objItem.Model)
			Next
			If strMan <> "" OR strMan <> NULL then
				objXL.Cells(intRow, 5).Value = strMan
			End If
			If strMod <> "" OR strMod <> NULL then
				objXL.Cells(intRow, 6).Value = strMod
			End If 
			Set colItems = Nothing
			Set objItem = Nothing
			' Dumping Infrastructure Roles
			'Is server a DC?
			strService = "kdc"
			If InStr(ExecCmd(pstoolsPath & "\psservice -accepteula \\" & _
				strCompName & " query " & strService), "RUNNING") <> 0 Then 
				
				objXL.Cells(intRow, 8).Value = "YES"
			End If
			'Is DNS installed?
			If InStr(ExecCmd(pstoolsPath & "\psservice -accepteula \\" & _
				strCompName & " query " & chr(34) & "DNS Server" & chr(34)), _
				"RUNNING") <> 0 Then 
				
				objXL.Cells(intRow, 9).Value = "YES"
			End If
			'Is DHCP installed?
			strService = "DHCPServer"
			If InStr(ExecCmd(pstoolsPath & "\psservice -accepteula \\" & _
				strCompName & " query " & strService), "RUNNING") <> 0 Then 
				
				objXL.Cells(intRow, 10).Value = "YES"
			End If
			'Is WINS installed?
			strService = "WINS"
			If InStr(ExecCmd(pstoolsPath & "\psservice -accepteula \\" & _
				strCompName & " query " & strService), "RUNNING") <> 0 Then 
				
				objXL.Cells(intRow, 11).Value = "YES"
			End If
			'Is server a Cluster Node?
			strService = "ClusSvc"
			If InStr(ExecCmd(pstoolsPath & "\psservice -accepteula \\" & _
				strCompName & " query " & strService), "RUNNING") <> 0 Then 
				
				objXL.Cells(intRow, 12).Value = "YES"
			End If
			'Is Exchange installed?
			strService = "MSExchangeSA"
			strService1 = "MSExchangeADTopology"
			If InStr(ExecCmd(pstoolsPath & "\psservice -accepteula \\" & _
				strCompName & " query " & strService), "RUNNING") <> 0 OR _
				InStr(ExecCmd(pstoolsPath & "\psservice -accepteula \\" & _
				strCompName & " query " & strService1), "RUNNING") <> 0 Then 
				
				objXL.Cells(intRow, 13).Value = "YES"
			End If
		Else
			objXL.Cells(intRow, 15).Value = "Error Connecting to WMI"
		End If
	Else
		objXL.Cells(intRow, 2).Value = "Not Ping'able"
	End If
	strRawOutput = ""
	tmpVar1 = ""
	tmpVar2 = ""
	tmpVar3 = ""
	strSN = ""
	intRow = intRow + 1
Next

Wscript.echo "All Done!"

Function FindAllServersInDomain(dom)
	' Returns an array with the names of all Windows servers in the domain specified.
	' Domain name format example: "DC=AD,DC=BLS,DC=com"

	Const ADS_SCOPE_SUBTREE = 2

	Dim objConnection, objCommand, objRecordSet, Var1, Var2

	Set objConnection = CreateObject("ADODB.Connection")
	Set objCommand = CreateObject("ADODB.Command")
	objConnection.Provider = "ADsDSOObject"
	objConnection.Open "Active Directory Provider"
	Set objCommand.ActiveConnection = objConnection
	objCommand.CommandText = _
		"Select Name, Location, operatingSystem from 'LDAP://" & dom & "'" _
		& " where objectClass='computer'" 
	objCommand.Properties("Page Size") = 1000
	objCommand.Properties("Timeout") = 30 
	objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
	objCommand.Properties("Cache Results") = False 
	Set objRecordSet = objCommand.Execute
	objRecordSet.MoveFirst
	Do Until objRecordSet.EOF
		If InStr(objRecordSet.Fields("operatingSystem").Value, "Server") <> 0 OR _
		InStr(objRecordSet.Fields("operatingSystem").Value, "Windows NT") <> 0 Then
			Var1 = Var1 & objRecordSet.Fields("Name").Value & ","
		End If
		objRecordSet.MoveNext
	Loop
	Var2 = Left(Var1, len(Var1) -1)
	FindAllServersInDomain = Split(Var2, ",", -1, 1)
End Function

Function GetPath()
    ' Get script path
    Dim path
    path = WScript.ScriptFullName
    GetPath = Left(path, InStrRev(path, "\")) 
End Function

Function Reachable(comp)
	Dim wmiQuery, objWMIService, objPing, objStatus
 
	wmiQuery = "Select * From Win32_PingStatus Where Address = '" & comp & "'"
 
	Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
	Set objPing = objWMIService.ExecQuery(wmiQuery)
 
	For Each objStatus in objPing
		If IsNull(objStatus.StatusCode) Or objStatus.Statuscode<>0 Then
			Reachable = False 'if computer is unreacable, return false
		Else
			Reachable = True 'if computer is reachable, return true
		End If
	Next
End Function

Function ExecCmd(Command)
	Dim oExec, WshShell, Line

	Set WshShell = WScript.CreateObject("WScript.Shell")
	Set oExec = WshShell.Exec(Command)
	Line = ""
	Do while oExec.Status <> 1
		If not oExec.StdOut.AtEndOfStream Then
			line = line & oExec.StdOut.ReadAll
		End If
		If not oExec.StdErr.AtEndOfStream Then
			line = line & oExec.StdErr.ReadAll
		End If
	Loop
	ExecCmd = Line
End Function