'==========================================================================
'
' VBScript Source File -- Created with SAPIEN Technologies PrimalScript 3.1
'
' NAME: Get Detailed Server Information.
'
' AUTHOR: Compiled by Eric Woodford
' DATE  : 10/9/2007
'
' COMMENT: Script reads a comma seperated txt file with server names in first column,
' 	   gathers server information, SP, DNS info, WINS, current IP, and outputs info to a CSV. 
'
'==========================================================================
Dim sp, ip, os, sDrives
Dim strOS, strServer, strComputerDN
Dim objfso, ef
Dim objRootDSE, strDNSDomain, adoConnection, adoCommand, strQuery
Dim adoRecordset

set objfso = CreateObject("Scripting.FileSystemObject")
set ef = objfso.CreateTextFile("c:\bin\scripts\servers\Server_Info.csv",vbtrue)

ef.writeline "Host,OS,Version,ServicePack #,MAC, IP,DNS1,DNS2,Drive, Free Space"


' 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

strQuery = "<LDAP://" & strDNSDomain _
    & ">;(objectCategory=computer);" _
    & "distinguishedName,operatingSystem;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
    strOS = adoRecordset.Fields("operatingSystem").Value
    If (InStr(UCase(strOS), "SERVER") > 0) Then
        strComputerDN = adoRecordset.Fields("distinguishedName").Value
		strServer = Mid(strComputerDN,4,InStr(strComputerDN,",")-4)
		WScript.Echo strServer & vbtab & strComputerDN & vbtab&  strOS
		If strServer <> "Host Name" Then 
			If Ping(strServer) Then 
				OS = GetOS(strServer)				
				If OS <> "" Then 
					' means WMI is enabled on the server.
					'SP = GetServicePack(strServer)  ' populated by GETOS function. 
					sDrives=GetFreeDriveSpace(strServer)
					IP=GetIP(strServer)
					ef.writeline strServer&","&OS&","& SP &","&IP&","&sDrives
				Else 										
					MyPC = GetNBTable(strServer)					
					IP=Mid(MyPC, InStr(mypc,"[")+1,InStr(mypc,"]")-(InStr(mypc,"[")+1))
					if instr(mypc,"MAC") Then 
						mac = replace(trim(Mid(mypc,InStr(mypc," Address =")+11,17)),"-",":")
					Else
						mac = ""
					End if
					ef.writeline strServer&","&strOS&",,,"&mac&","&IP &"," & """" &strComputerDN & """"
				End if
			Else
				ip = "non-responsive"
				'ef.writeline strServer&","&IP &"," & """" &strComputerDN & """"
			End If			
		End If
	End if
    adoRecordset.MoveNext
Loop
adoRecordset.Close
ef.close

Function Ping(strHost)
' Use WMI to pull PING status from server. Great if supporst WMI. 
    dim objPing, objRetStatus
    set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery _
      ("select * from Win32_PingStatus where address = '" & strHost & "'")

    for each objRetStatus in objPing
        if IsNull(objRetStatus.StatusCode) or objRetStatus.StatusCode<>0 then
    		Ping = False            
        else
            Ping = True
        end if
    next
End Function 


Function GetOS(strComputer)
' Use WMI to pull OS information. Returns NULL if no WMI support
Dim OS
On Error Resume next
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colOperatingSystems = objWMIService.ExecQuery ("Select * from Win32_OperatingSystem")
For Each objOperatingSystem in colOperatingSystems
    OS = objOperatingSystem.Caption &" "& objOperatingSystem.Version
    ' add a comma to Windows 2000 version to make formatting similar to 2003. 
    If InStr(OS," 2000 ") Then OS=TRIM(mid(OS,1,InStr(OS,"2000")+4))&","&TRIM(mid(OS,InStr(OS,"2000")+4,Len(OS)))
    sp = objOperatingSystem.ServicePackMajorVersion & "." & objOperatingSystem.ServicePackMinorVersion
Next
GetOS = OS 
End Function

Function GetServicePack(strComputer)
On Error Resume next
	Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
	Set colOperatingSystems = objWMIService.ExecQuery ("Select * from Win32_OperatingSystem")
	For Each objOperatingSystem in colOperatingSystems
    	GetServicePack = objOperatingSystem.ServicePackMajorVersion & "." & objOperatingSystem.ServicePackMinorVersion
	Next	
End Function


Function GetNBTable(strPCName)
' Use cmd prompt to run NBTStat to gather IP and possibly MAC address.
Const FOR_READING = 1
CONST TempPath = "c:\"

Dim objShell, objFSO, objNBTFile
Dim strNBCommand
	Set objShell = WScript.CreateObject("WScript.Shell")
	Set objFSO = CreateObject("Scripting.FileSystemObject")
   ' Store command prompt to use.
   strNBCommand = "ping -a " & strPCName   
   objShell.Run "Cmd.exe /c " & strNBCommand & " > " & TempPath & "NBTList.txt", 2, True
   
   strNBCommand = "nbtstat -a " & strPCName   
   objShell.Run "Cmd.exe /c " & strNBCommand & " >> " & TempPath & "NBTList.txt", 2, True
   ' Open NBTList.txt file.
   Set objNBTFile = objFSO.OpenTextFile(TempPath & "NBTList.txt", FOR_READING, True)
   ' Store content of text file, close it and delete text file.
   GetNBTable = objNBTFile.ReadAll
   objNBTFile.Close
   objFSO.DeleteFile(TempPath & "NBTList.txt")
   Set objNBTFile = Nothing
   Set objshell = Nothing
   Set objFSO = nothing
End Function


Function GetFreeDriveSpace(strComputer)
' queries all local disks and returns % free space available. 
'http://www.microsoft.com/technet/scriptcenter/resources/qanda/oct04/hey1013.mspx
On Error Resume next
Dim AllHD
	Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
	Set colDisks = objWMIService.ExecQuery ("Select * from Win32_LogicalDisk Where DriveType = 3")
	AllHD = ""	
	For Each objDisk in colDisks
	    intFreeSpace = objDisk.FreeSpace
	    intTotalSpace = objDisk.Size
	    pctFreeSpace = intFreeSpace / intTotalSpace
	    AllHD= AllHD & objDisk.DeviceID &","& FormatPercent(pctFreeSpace)&","	    
	Next
	GetFreeDriveSpace=AllHD	
End Function


Function GetIP(strComputer)
' get IP, MAC & DNS server address from each NIC in computer. May return mulitple entries based on server. 
' portions from http://techtasks.com/code/viewbookcode/319
On Error Resume Next 
Dim MyNet, spacer, strAddress
Dim objWMIService, colItems
Dim objItem, strName 
dim x
	Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
	Set colItems = objWMIService.ExecQuery ("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")
	MyNet=""	
	spacer = ""
	x=0
	For Each objItem in colItems	    
	    MyNet= MyNet & spacer & objItem.MACAddress
	    For Each strAddress in objItem.IPAddress
	        MyNet=MyNet& ","& strAddress
	    Next
	    if IsArray(objItem.DNSServerSearchOrder) then
 			for each strName in objItem.DNSServerSearchOrder
 				MyNet= MyNet &"," & strName
 			Next
 		Else 
 			MyNet = MyNet & ",,"
 		end If
 		if spacer="" then spacer = ","
	Next
	GetIP = MyNet
End Function