ComputerInventory.vbs

'=========================================================================
' ComputerInventory.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: [email protected]
' WEB: https://sigkillit.com
' DATE: 1/21/2013
' COMPATIBLE: Windows XP+, Server 2003+. If you are using on Windows 2003,
'  to get correct CPU Physical and Core Counts make sure you have the following
'  hotfix installed: http://support.microsoft.com/kb/932370
' COMMENTS: Loops through a line delineated list of servers and reports back
'  the Manufacturer, Model #, Serial #, Windows OS, OS Architecture (32vs64),
'  RAM(MB), CPU Description, CPU Speed(GHz), CPU Physical Count, CPU Core Count,
'  Local Volumes with Total and Used Space in GB.
'  Edit the configuration to point to a text file containing the names of
'  the computers to inventory. By default, it will search the same directory
'  of the script, otherwise you can provide the full path. Also, set the max
'  number of Disk Volumes you want to return. By default, this is set to 5 but,
'  you may need to increase this number if your computers use a lot of volumes.
' EXAMPLE: Inventory Servers.txt in the Current Directory with a max of 5 volumes
'  Dim computerList: computerList = "servers.txt"
'  Dim maxVolumes: maxVolumes = 5
' EXAMPLE: Inventory Servers.txt using a full path with a max of 8 volumes
'  Dim computerList: computerList = "C:\servers.txt"
'  Dim maxVolumes: maxVolumes = 8
'=========================================================================
Option Explicit
' ------ SCRIPT CONFIGURATION ------
Dim computerList: computerList = "servers.txt"
Dim maxVolumes: maxVolumes = 5
' ------ END CONFIGURATION ------

'Ensure Computer List Exists
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FileExists(computerList) Then
    Wscript.Echo "ERROR - Input File Does Not Exist!" & vbCrLf & vbCrLf & "Quitting Script!"
    Wscript.Quit
End If

'Create Log File
Dim strLogFile: strLogFile = Replace(Wscript.ScriptName, ".vbs", ".txt")
Dim strHeadings: strHeadings = "COMPUTER" & vbTab & _
    "MAKE" & vbTab & _
    "MODEL" & vbTab & _
    "SERIAL" & vbTab & _
    "OS" & vbTab & _
    "ARCHITECTURE" & vbTab & _
    "RAM(MB)" & vbTab & _
    "CPU" & vbTab & _
    "SPEED(GHz)" & vbTab & _
    "PHYSICAL" & vbTab & _
    "CORE"
Dim i
Dim strVolumes: strVolumes = ""
If maxVolumes > 0 Then
    For i = 1 to maxVolumes
        strVolumes = strVolumes & vbTab & "HDD(Used/Total)"
    Next
Else
    'Default to Single Volume If an Invalid # Was Assigned
    maxVolumes = 1
End If
strHeadings = strHeadings & strVolumes
Call Logger(strLogFile, strHeadings, True)

'Get Server Info
Const ForReading = 1
Dim objTextFile: Set objTextFile = objFSO.OpenTextFile(computerList, ForReading)
Dim strComp, strManufacturer, strModel, strSerial, strOS, strOSArchitecture, strRAM, strProcessor, strVolume, strTemp
Do Until objTextFile.AtEndOfStream
    strComp = Trim(objTextFile.Readline)
    If strComp <> "" Then
        If ServerUpTime(strComp) = "!~ERROR~!" Then
            strTemp = strComp & "(Offline)" & vbTab & _
                "!~ERROR~!" & vbTab & _
                "!~ERROR~!" & vbTab & _
                "!~ERROR~!" & vbTab & _
                "!~ERROR~!" & vbTab & _
                "!~ERROR~!" & vbTab & _
                "!~ERROR~!" & vbTab & _
                "!~ERROR~!" & vbTab & _
                "!~ERROR~!" & vbTab & _
                "!~ERROR~!" & vbTab & _
                "!~ERROR~!" & Replace(strVolumes, "HDD(Used/Total)", "!~ERROR~!")
            Call Logger(strLogFile, strTemp, False)
        Else   
            strManufacturer = GetManufacturer(strComp)
            strModel = GetModel(strComp)
            strSerial = GetSerial(strComp)
            strOS = GetOS(strComp)
            strOSArchitecture = GetOSArchitecture(strComp)
            strRAM = GetRAM(strComp)
            strProcessor = GetProcessor(strComp)
            strVolume = GetVolume(strComp, maxVolumes)
            Call Logger(strLogFile, strComp & vbTab & strManufacturer & vbTab & strModel & vbTab & strSerial & vbTab & strOS & vbTab & strOSArchitecture & vbTab & strRAM & vbTab & strProcessor & vbTab & strVolume, False)
        End If
    End If
Loop           
Wscript.Echo "Finished"

Private Function ServerUpTime(strComputer)

    On Error Resume Next

    Dim objWMISettings: Set objWMISettings = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Dim colItems: Set colItems = objWMISettings.ExecQuery("Select * from Win32_OperatingSystem")
    Dim strResult
    Dim objItem, dtmBootup, dtmLastBootupTime, dtmSystemUptime
    For Each objItem in colItems
        dtmBootup = objItem.LastBootUpTime
        dtmLastBootupTime = CDate(Mid(dtmBootup, 5, 2) & "/" & Mid(dtmBootup, 7, 2) & "/" & Left(dtmBootup, 4) & " " & Mid (dtmBootup, 9, 2) & ":" & Mid(dtmBootup, 11, 2) & ":" & Mid(dtmBootup, 13, 2))
        dtmSystemUptime = DateDiff("h", dtmLastBootUpTime, Now)
    Next

    'Return Results
    If Err.Number <> 0 Then
        Err.Clear
        strResult = "!~ERROR~!"
    Else
        strResult = dtmSystemUptime
    End If 
    ServerUpTime = strResult

    'Kill Objects
    Set objWMISettings = Nothing

    On Error GoTo 0  ' End Error Handling

End Function

Private Function GetManufacturer(strComputer)

    On Error Resume Next

    Dim objWMIService: Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Dim colItems: Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem")
    Dim strResult
    Dim objItem
    For Each objItem in colItems
        strResult = Trim(objItem.Manufacturer)
    Next

    'Return Results
    If Err.Number <> 0 Then
        Err.Clear
        strResult = "!~ERROR~!"
    End If
    GetManufacturer = strResult

    'Kill Objects
    Set objWMIService = Nothing

    On Error Goto 0

End Function

Private Function GetModel(strComputer)

    On Error Resume Next

    Dim objWMIService: Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Dim colItems: Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem")
    Dim strResult
    Dim objItem
    For Each objItem in colItems
        strResult = Trim(objItem.Model)
    Next

    'Return Results
    If Err.Number <> 0 Then
        Err.Clear
        strResult = "!~ERROR~!"
    End If
    GetModel = strResult

    'Kill Objects
    Set objWMIService = Nothing

    On Error Goto 0

End Function

Private Function GetSerial(strComputer)

    On Error Resume Next

    Dim objWMIService: Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Dim colItems: Set colItems = objWMIService.ExecQuery("Select * from Win32_BIOS")
    Dim strResult
    Dim objItem
    For Each objItem in colItems
        strResult = Trim(objItem.SerialNumber)
    Next

    'Return Results
    If Err.Number <> 0 Then
        Err.Clear
        strResult = "!~ERROR~!"
    End If
    GetSerial = strResult

    'Kill Objects
    Set objWMIService = Nothing

    On Error Goto 0

End Function

Private Function GetOS(strComputer)

    On Error Resume Next

    Dim objWMIService: Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Dim colItems: Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
    Dim strResult
    Dim objItem
    For Each objItem in colItems
        strResult = Trim(objItem.Caption)
    Next

    'Return Results
    If Err.Number <> 0 Then
        Err.Clear
        strResult = "!~ERROR~!"
    End If
    GetOS = strResult

    'Kill Objects
    Set objWMIService = Nothing

    On Error Goto 0

End Function

Private Function GetOSArchitecture(strComputer)

    On Error Resume Next

    Dim objWMIService: Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate,authenticationLevel=Pkt}!\\" & strComputer & "\root\cimv2")
    Dim colItems: Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Processor")
    Dim strResult
    Dim objItem
    For Each objItem In colItems
        Select Case objItem.Architecture
            Case 0
                strResult = "32-bit"
            Case 9
                strResult = "64-bit"           
        End Select
    Next

    'Return Results
    If Err.Number <> 0 Then
        Err.Clear
        strResult = "!~ERROR~!"
    End If 
    GetOSArchitecture = strResult

    'Kill Ovjects
    Set objWMIService = Nothing

    On Error Goto 0

End Function

Private Function GetRAM(strComputer)

    On Error Resume Next

    Dim objWMIService: Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Dim colItems: Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem")
    Dim strResult
    Dim objItem
    For Each objItem in colItems
        strResult = Round(objItem.TotalPhysicalMemory/1024/1024,0)
    Next

    'Return Results
    If Err.Number <> 0 Then
        Err.Clear
        strResult = "!~ERROR~!"
    End If 
    GetRAM = strResult

    'Kill Objects
    Set objWMIService = Nothing

    On Error Goto 0

End Function

Private Function GetProcessor(strComputer)

    'If Using Server 2003 Install the Following Hotfix to Get Correct Physical and Core CPU Counts
    'http://support.microsoft.com/kb/932370

    On Error Resume Next

    Dim objWMIService: Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
    Dim colItems: Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Processor")
    Dim strResult
    Dim objItem
    Dim strCPU: strCPU = ""
    Dim strSpeed: strSpeed = ""
    Dim intPhysical: intPhysical = 0
    Dim intCores: intCores = 0
    For Each objItem in colItems
        strCPU = objItem.Description
        strSpeed = Round(objItem.CurrentClockSpeed/1000,2)
        intPhysical = colItems.Count
        intCores = objItem.NumberOfCores
    Next

    'Return Results
    If Err.Number <> 0 Then
        Err.clear
        strResult = "!~ERROR~!" & vbTab & "!~ERROR~!" & vbTab & "!~ERROR~!" & vbTab & "!~ERROR~!"
    Else
        strResult = strCPU & vbTab & strSpeed & vbTab & intPhysical & vbTab & intCores
    End If     
    GetProcessor = strResult

    'Kill Objects
    Set objWMIService = Nothing

    On Error Goto 0

End Function

Private Function GetVolume(strComputer, maxVolCount)

    On Error Resume Next

    Dim objWMIService: Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Dim colItems: Set colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk WHERE DriveType='3'")
    Dim strResult: strResult = ""
    Dim objItem, totalSpace, usedSpace
    Dim i: i = 0
    For Each objItem in colItems
        totalSpace = FormatNumber(objItem.Size/1024/1024/1024)
        usedSpace = FormatNumber((objItem.Size - objItem.FreeSpace)/1024/1024/1024)
        i = i + 1
        If i = 1 Then
            strResult = objItem.DeviceID & "(" & usedSpace & "/" & totalSpace & ")"
        Elseif i > maxVolCount Then
            'Skip
        Else
            strResult = strResult & vbTab & objItem.DeviceID & "(" & usedSpace & "/" & totalSpace & ")"
        End If
    Next
    If colItems.Count < maxVolCount Then
        For i = 1 to maxVolCount - colItems.Count
            strResult = strResult & vbTab & "N/A"
        Next
    End If

    'Return Results
    If Err.Number <> 0 Then
        Err.Clear
        If maxVolCount > 0 Then
            For i = 1 to maxVolCount
                If i = 1 Then
                    strResult = "!~ERROR~!"
                Else
                    strResult = strResult & vbTab & "!~ERROR~!"
                End If
            Next
        Else
            strResult = "!~ERROR~!"
        End If
    End If 
    GetVolume = strResult

    'Kill Objects
    Set objWMIService = Nothing

    On Error Goto 0

End Function

Private Sub Logger(fileName, logMessage, blnNewLog)

    On Error Resume Next

    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim scriptPath: scriptPath = Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\"))
    Dim logName
    If InStr(1,fileName,"\",1) > 0 Then
        logName = fileName
        If objFSO.DriveExists(objFSO.GetDriveName(logName)) Then
            If StrComp(objFSO.GetExtensionName(logName), "", 1) = 0 Then
                If Not objFSO.FolderExists(logName) Then
                    If objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then
                        objFSO.CreateFolder logName 'Create Folder In Current Path
                        Exit Sub
                    Else
                        Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog) 'Recurse Creating Parent Folder
                        Call Logger(logName, logMessage, blnNewLog) 'Recurse Creating Current Folder
                        Exit Sub
                    End If
                End If
            Else
                If Not objFSO.FileExists(logName) Then
                    If Not objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then
                        Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog)  'Recurse Creating Parent Folder
                        Call Logger(logName, logMessage, blnNewLog)  'Recurse Creating Current Folder
                    End If
                End If
            End If
        End If
    Else
        logName = scriptPath & fileName
    End If
    Dim logFile
    If blnNewLog = True Then
        Set logFile = objFSO.CreateTextFile(logName, True)
    Else
        If objFSO.FileExists(logName) Then
            Set logFile = objFSO.OpenTextFile(logName, ForAppending, True)
        Else
            Set logFile = objFSO.CreateTextFile(logName, True)
        End If
    End If
    logFile.WriteLine logMessage
    logFile.Close
    Set objFSO = Nothing

    On Error Goto 0

End Sub