Home > Scripts, Windows > Computer Info VBScript

Computer Info VBScript

EDIT 9th January 2010 – the script has gone a fairly major revision due to changes in the Office 2010 product key storage location, as well as migrating this to a class-based script for speed.

Again, another side project – a computer info VBScript. I’ve modified it a bit to output information to screen (execute with cscript from a cmd prompt), but this could be modified to do a lot more. This is just a simple script template, and as usual I’m posting here for consumption in the event anyone finds this useful:

'// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'//
'// NAME:        osinfo.vbs
'//
'// Original:    http://www.cluberti.com/blog
'// Last Update: 15th January 2010
'//
'// Comment:     VBS example file for use as an OS info gathering template.
'//
'// NOTE:        Provided as-is - usage of this source assumes that you are at the
'//              very least familiar with the vbscript language being used and
'//              the tools used to create and debug this file.
'//
'//              In other words, if you break it, you get to keep the pieces.
'//
'//              Also, if you want to use this on W2K, prepare to hack, as this
'//              was really designed with XP+ systems in mind.
'//
'// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'//
'// This script will require elevated privileges if run from a non-admin account, so
'// calling the ElevateThisScript() Sub should get the script a full admin token. This is
'// currently disabled, but if you need non-admin users to run this script, enable the
'// call to this subroutine to pop-up a dialog box (they'll of course need administrative
'// credentials to put in the challenge dialog before the script will execute with an
'// administrative token):

Dim ScriptHelper
Set ScriptHelper = New ScriptHelperClass

ScriptHelper.RunMeWithCScript()
'ScriptHelper.ElevateThisScript()

'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'//
'// Set variables and WMI connections for scripting against:

strComputer = ScriptHelper.Network.ComputerName

CONST HKEY_CLASSES_ROOT  = &H80000000
CONST HKEY_CURRENT_USER  = &H80000001
CONST HKEY_LOCAL_MACHINE = &H80000002
CONST HKEY_USERS         = &H80000003
CONST KEY_QUERY_VALUE      = 1
CONST KEY_SET_VALUE          = 2
CONST SEARCH_KEY = "DigitalProductID"

Dim arrSubKeys(4,1)
Dim foundKeys
Dim iValues, arrDPID
foundKeys = Array()
iValues = Array()
arrSubKeys(0,0) = "Windows PID Key:       "
arrSubKeys(0,1) = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"
arrSubKeys(2,0) = "Office XP PID Key:     "
arrSubKeys(2,1) = "SOFTWARE\Microsoft\Office\10.0\Registration"
arrSubKeys(1,0) = "Office 2003 PID Key:   "
arrSubKeys(1,1) = "SOFTWARE\Microsoft\Office\11.0\Registration"
arrSubKeys(3,0) = "Office 2007 PID Key:   "
arrSubKeys(3,1) = "SOFTWARE\Microsoft\Office\12.0\Registration"
arrSubKeys(4,0) = "Office 2010 PID Key:   "

Arch = ""
Sku = ""

Set colOSItems = ScriptHelper.WMI.ExecQuery( _
    "SELECT * FROM Win32_OperatingSystem",,48)

Set colProcItems = ScriptHelper.WMI.ExecQuery( _
    "SELECT * FROM Win32_Processor",,48)

Set colCompSysItems = ScriptHelper.WMI.ExecQuery( _
    "SELECT * FROM Win32_ComputerSystem",,48)

Set colTZItems = ScriptHelper.WMI.ExecQuery( _
    "SELECT * FROM Win32_TimeZone",,48)

Set colCompSysProdItems = ScriptHelper.WMI.ExecQuery( _
    "SELECT * FROM Win32_ComputerSystemProduct",,48)

Set colBIOSItems = ScriptHelper.WMI.ExecQuery( _
    "SELECT * FROM Win32_BIOS",,48)

Set colDiskItems = ScriptHelper.WMI.ExecQuery( _
    "SELECT * FROM Win32_LogicalDisk",,48)

Set colNetAdapConfigItems = ScriptHelper.WMI.ExecQuery( _
    "SELECT * FROM Win32_NetworkAdapterConfiguration",,48)

Set colVideoItems = ScriptHelper.WMI.ExecQuery( _
    "SELECT * FROM Win32_VideoController",,48)

Set colSoundItems = ScriptHelper.WMI.ExecQuery( _
    "SELECT * FROM Win32_SoundDevice",,48)

'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'//
'// If Office 2010 is installed, find the Office 2010 registry key holding the ProductID:

Dim strKey, subkey, arrSubkeys2, strOfficeKey, strValue
strKey = "SOFTWARE\Microsoft\Office\14.0\Registration"

ScriptHelper.Registry.EnumKey HKEY_LOCAL_MACHINE, strKey, arrSubkeys2
If IsNull(arrSubkeys2) Then
    'Office 2010 not installed, skip it
    arrSubKeys(4,1) = ""
Else
    For Each subkey In arrSubkeys2
        ScriptHelper.Registry.GetBinaryValue HKEY_LOCAL_MACHINE, strKey & "\" & subkey, SEARCH_KEY, strValue
        If IsNull(strValue) Then
            strOfficeKey = ""
        Else
            strOfficeKey = strKey & "\" & subkey
            arrSubKeys(4,1) = strOfficeKey
        End If
    Next
End If

'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'//
'// Get OS SKU from Win32_OperatingSystem class:

    For Each objOSItem in colOSItems
    If objOSItem.BuildNumber => 6000 Then
        Arch = objOSItem.OSArchitecture

        Select Case objOSItem.OperatingSystemSKU
            Case 0 Sku = "Unknown Windows version"
            Case 1 Sku = "Ultimate Edition"
            Case 2 Sku = "Home Basic Edition"
            Case 3 Sku = "Home Premium Edition"
            Case 4 Sku = "Enterprise Edition"
            Case 5 Sku = "Home Basic N Edition"
            Case 6 Sku = "Business Edition"
            Case 7 Sku = "Standard Server Edition"
            Case 8 Sku = "Datacenter Server Edition"
            Case 9 Sku = "Small Business Server Edition"
            Case 10 Sku = "Enterprise Server Edition"
            Case 11 Sku = "Starter Edition"
            Case 12 Sku = "Datacenter Server Core Edition"
            Case 13 Sku = "Standard Server Core Edition"
            Case 14 Sku = "Enterprise Server Core Edition"
            Case 15 Sku = "Enterprise Server Edition for Itanium-Based Systems"
            Case 16 Sku = "Business N Edition"
            Case 17 Sku = "Web Server Edition"
            Case 18 Sku = "Cluster Server Edition"
            Case 19 Sku = "Home Server Edition"
            Case 20 Sku = "Storage Express Server Edition"
            Case 21 Sku = "Storage Standard Server Edition"
            Case 22 Sku = "Storage Workgroup Server Edition"
            Case 23 Sku = "Storage Enterprise Server Edition"
            Case 24 Sku = "Server For Small Business Edition"
            Case 25 Sku = "Small Business Server Premium Edition"
            Case Else
            Sku = "Could Not Determine Operating System SKU"
        End Select
    End If

'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'//
'// Get current OS locale setting from Win32_OperatingSystem class:

        Select Case objOSItem.Locale
            Case 0436 Locale = "Afrikaans (South Africa)"
            Case 041c Locale = "Albanian (Albania)"
            ' Case 045e Locale = "Amharic (Ethiopia)"
            Case 0401 Locale = "Arabic (Saudi Arabia)"
            Case 1401 Locale = "Arabic (Algeria)"
            Case 3c01 Locale = "Arabic (Bahrain)"
            Case 0c01 Locale = "Arabic (Egypt)"
            Case 0801 Locale = "Arabic (Iraq)"
            Case 2c01 Locale = "Arabic (Jordan)"
            Case 3401 Locale = "Arabic (Kuwait)"
            Case 3001 Locale = "Arabic (Lebanon)"
            Case 1001 Locale = "Arabic (Libya)"
            Case 1801 Locale = "Arabic (Morocco)"
            Case 2001 Locale = "Arabic (Oman)"
            Case 4001 Locale = "Arabic (Qatar)"
            Case 2801 Locale = "Arabic (Syria)"
            Case 1c01 Locale = "Arabic (Tunisia)"
            Case 3801 Locale = "Arabic (U.A.E.)"
            Case 2401 Locale = "Arabic (Yemen)"
            Case 042b Locale = "Armenian (Armenia)"
            Case 044d Locale = "Assamese"
            Case 082c Locale = "Azeri (Cyrillic)"
            Case 042c Locale = "Azeri (Latin)"
            Case 042d Locale = "Basque"
            Case 0423 Locale = "Belarusian"
            Case 0445 Locale = "Bengali (India)"
            Case 0845 Locale = "Bengali (Bangladesh)"
            Case 141A Locale = "Bosnian (Bosnia/Herzegovina)"
            Case 0402 Locale = "Bulgarian"
            Case 0455 Locale = "Burmese"
            Case 0403 Locale = "Catalan"
            Case 045c Locale = "Cherokee (United States)"
            Case 0804 Locale = "Chinese (PRC)"
            Case 1004 Locale = "Chinese (Singapore)"
            Case 0404 Locale = "Chinese (Taiwan)"
            Case 0c04 Locale = "Chinese (Hong Kong SAR)"
            Case 1404 Locale = "Chinese (Macao SAR)"
            Case 041a Locale = "Croatian"
            Case 101a Locale = "Croatian (Bosnia/Herzegovina)"
            Case 0405 Locale = "Czech"
            Case 0406 Locale = "Danish"
            Case 0465 Locale = "Divehi"
            Case 0413 Locale = "Dutch (Netherlands)"
            Case 0813 Locale = "Dutch (Belgium)"
            Case 0466 Locale = "Edo"
            Case 0409 Locale = "English (United States)"
            Case 0809 Locale = "English (United Kingdom)"
            Case 0c09 Locale = "English (Australia)"
            Case 2809 Locale = "English (Belize)"
            Case 1009 Locale = "English (Canada)"
            Case 2409 Locale = "English (Caribbean)"
            Case 3c09 Locale = "English (Hong Kong SAR)"
            Case 4009 Locale = "English (India)"
            Case 3809 Locale = "English (Indonesia)"
            Case 1809 Locale = "English (Ireland)"
            Case 2009 Locale = "English (Jamaica)"
            Case 4409 Locale = "English (Malaysia)"
            Case 1409 Locale = "English (New Zealand)"
            Case 3409 Locale = "English (Philippines)"
            Case 4809 Locale = "English (Singapore)"
            Case 1c09 Locale = "English (South Africa)"
            Case 2c09 Locale = "English (Trinidad)"
            Case 3009 Locale = "English (Zimbabwe)"
            Case 0425 Locale = "Estonian"
            Case 0438 Locale = "Faroese"
            Case 0429 Locale = "Farsi"
            Case 0464 Locale = "Filipino"
            Case 040b Locale = "Finnish"
            Case 040c Locale = "French (France)"
            Case 080c Locale = "French (Belgium)"
            Case 2c0c Locale = "French (Cameroon)"
            Case 0c0c Locale = "French (Canada)"
            Case 240c Locale = "French (DRC)"
            Case 300c Locale = "French (Cote d'Ivoire)"
            Case 3c0c Locale = "French (Haiti)"
            Case 140c Locale = "French (Luxembourg)"
            Case 340c Locale = "French (Mali)"
            Case 180c Locale = "French (Monaco)"
            Case 380c Locale = "French (Morocco)"
            Case e40c Locale = "French (North Africa)"
            Case 200c Locale = "French (Reunion)"
            Case 280c Locale = "French (Senegal)"
            Case 100c Locale = "French (Switzerland)"
            Case 1c0c Locale = "French (West Indies)"
            Case 0462 Locale = "Frisian (Netherlands)"
            Case 0467 Locale = "Fulfulde (Nigeria)"
            Case 042f Locale = "FYRO Macedonian"
            Case 083c Locale = "Gaelic (Ireland)"
            Case 043c Locale = "Gaelic (Scotland)"
            Case 0456 Locale = "Galician"
            Case 0437 Locale = "Georgian"
            Case 0407 Locale = "German (Germany)"
            Case 0c07 Locale = "German (Austria)"
            Case 1407 Locale = "German (Liechtenstein)"
            Case 1007 Locale = "German (Luxembourg)"
            Case 0807 Locale = "German (Switzerland)"
            Case 0408 Locale = "Greek"
            Case 0474 Locale = "Guarani (Paraguay)"
            Case 0447 Locale = "Gujarati"
            Case 0468 Locale = "Hausa (Nigeria)"
            Case 0475 Locale = "Hawaiian (United States)"
            Case 040d Locale = "Hebrew"
            Case 0439 Locale = "Hindi"
            ' Case 040e Locale = "Hungarian"
            Case 0469 Locale = "Ibibio (Nigeria)"
            Case 040f Locale = "Icelandic"
            Case 0470 Locale = "Igbo (Nigeria)"
            Case 0421 Locale = "Indonesian"
            Case 045d Locale = "Inuktitut"
            Case 0410 Locale = "Italian (Italy)"
            Case 0810 Locale = "Italian (Switzerland)"
            Case 0411 Locale = "Japanese"
            Case 044b Locale = "Kannada"
            Case 0471 Locale = "Kanuri (Nigeria)"
            Case 0860 Locale = "Kashmiri"
            Case 0460 Locale = "Kashmiri (Arabic)"
            Case 043f Locale = "Kazakh"
            Case 0453 Locale = "Khmer"
            Case 0457 Locale = "Konkani"
            Case 0412 Locale = "Korean"
            Case 0440 Locale = "Kyrgyz (Cyrillic)"
            Case 0454 Locale = "Lao"
            Case 0476 Locale = "Latin"
            Case 0426 Locale = "Latvian"
            Case 0427 Locale = "Lithuanian"
            ' Case 043e Locale = "Malay (Malaysia)"
            ' Case 083e Locale = "Malay (Brunei Darussalam)"
            Case 044c Locale = "Malayalam"
            Case 043a Locale = "Maltese"
            Case 0458 Locale = "Manipuri"
            Case 0481 Locale = "Maori (New Zealand)"
            ' Case 044e Locale = "Marathi"
            Case 0450 Locale = "Mongolian (Cyrillic)"
            Case 0850 Locale = "Mongolian (Mongolian)"
            Case 0461 Locale = "Nepali"
            Case 0861 Locale = "Nepali (India)"
            Case 0414 Locale = "Norwegian (Bokmål)"
            Case 0814 Locale = "Norwegian (Nynorsk)"
            Case 0448 Locale = "Oriya"
            Case 0472 Locale = "Oromo"
            Case 0479 Locale = "Papiamentu"
            Case 0463 Locale = "Pashto"
            Case 0415 Locale = "Polish"
            Case 0416 Locale = "Portuguese (Brazil)"
            Case 0816 Locale = "Portuguese (Portugal)"
            Case 0446 Locale = "Punjabi"
            Case 0846 Locale = "Punjabi (Pakistan)"
            Case 046B Locale = "Quecha (Bolivia)"
            Case 086B Locale = "Quecha (Ecuador)"
            Case 0C6B Locale = "Quecha (Peru)"
            Case 0417 Locale = "Rhaeto-Romanic"
            Case 0418 Locale = "Romanian"
            Case 0818 Locale = "Romanian (Moldava)"
            Case 0419 Locale = "Russian"
            Case 0819 Locale = "Russian (Moldava)"
            Case 043b Locale = "Sami (Lappish)"
            Case 044f Locale = "Sanskrit"
            Case 046c Locale = "Sepedi"
            Case 0c1a Locale = "Serbian (Cyrillic)"
            Case 081a Locale = "Serbian (Latin)"
            Case 0459 Locale = "Sindhi (India)"
            Case 0859 Locale = "Sindhi (Pakistan)"
            Case 045b Locale = "Sinhalese (Sri Lanka)"
            Case 041b Locale = "Slovak"
            Case 0424 Locale = "Slovenian"
            Case 0477 Locale = "Somali"
            ' Case 042e Locale = "Sorbian"
            Case 0c0a Locale = "Spanish (Spain - Modern Sort)"
            Case 040a Locale = "Spanish (Spain - Traditional Sort)"
            Case 2c0a Locale = "Spanish (Argentina)"
            Case 400a Locale = "Spanish (Bolivia)"
            Case 340a Locale = "Spanish (Chile)"
            Case 240a Locale = "Spanish (Colombia)"
            Case 140a Locale = "Spanish (Costa Rica)"
            Case 1c0a Locale = "Spanish (Dominican Republic)"
            Case 300a Locale = "Spanish (Ecuador)"
            Case 440a Locale = "Spanish (El Salvador)"
            Case 100a Locale = "Spanish (Guatemala)"
            Case 480a Locale = "Spanish (Honduras)"
            Case 580a Locale = "Spanish (Latin America)"
            Case 080a Locale = "Spanish (Mexico)"
            Case 4c0a Locale = "Spanish (Nicaragua)"
            Case 180a Locale = "Spanish (Panama)"
            Case 3c0a Locale = "Spanish (Paraguay)"
            Case 280a Locale = "Spanish (Peru)"
            Case 500a Locale = "Spanish (Puerto Rico)"
            Case 540a Locale = "Spanish (United States)"
            Case 380a Locale = "Spanish (Uruguay)"
            Case 200a Locale = "Spanish (Venezuela)"
            Case 0430 Locale = "Sutu"
            Case 0441 Locale = "Swahili"
            Case 041d Locale = "Swedish"
            Case 081d Locale = "Swedish (Finland)"
            Case 045a Locale = "Syriac"
            Case 0428 Locale = "Tajik"
            Case 045f Locale = "Tamazight (Arabic)"
            Case 085f Locale = "Tamazight (Latin)"
            Case 0449 Locale = "Tamil"
            Case 0444 Locale = "Tatar"
            Case 044a Locale = "Telugu"
            ' Case 041e Locale = "Thai"
            Case 0851 Locale = "Tibetan (Bhutan)"
            Case 0451 Locale = "Tibetan (PRC)"
            Case 0873 Locale = "Tigrigna (Eritrea)"
            Case 0473 Locale = "Tigrigna (Ethiopia)"
            Case 0431 Locale = "Tsonga"
            Case 0432 Locale = "Tswana"
            Case 041f Locale = "Turkish"
            Case 0442 Locale = "Turkmen"
            Case 0480 Locale = "Uighur (China)"
            Case 0422 Locale = "Ukrainian"
            Case 0420 Locale = "Urdu"
            Case 0820 Locale = "Urdu (India)"
            Case 0843 Locale = "Uzbek (Cyrillic)"
            Case 0443 Locale = "Uzbek (Latin)"
            Case 0433 Locale = "Venda"
            Case 042a Locale = "Vietnamese"
            Case 0452 Locale = "Welsh"
            Case 0434 Locale = "Xhosa"
            Case 0478 Locale = "Yi"
            Case 043d Locale = "Yiddish"
            Case 046a Locale = "Yoruba"
            Case 0435 Locale = "Zulu"
            Case 04ff Locale = "HID (Human Interface Device)"
            Case Else
            Locale = "Could Not Determine OS Locale"
        End Select

'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'//
'// Set variables gathered from Win32_OperatingSystem class:

        Caption = objOSItem.Caption
        CSDVersion = objOSItem.CSDVersion
        CSName = objOSItem.CSName
        Version = objOSItem.Version
        BuildType = objOSItem.BuildType
        BuildNumber = objOSItem.BuildNumber
        SerialNumber = objOSItem.SerialNumber

        ScriptHelper.SWbemDateTime.Value = objOSItem.InstallDate
        InstallDate = ScriptHelper.SWbemDateTime.GetVarDate(True)

        ScriptHelper.SWbemDateTime.Value = objOSItem.LastBootUpTime
        LastBootUpTime = ScriptHelper.SWbemDateTime.GetVarDate(True)

        Status = objOSItem.Status
    Next

'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'//
'// Set variables gathered from Win32_ComputerSystem class:

    For Each objCompSysItem in colCompSysItems
        CurrentTimeZone = objCompSysItem.CurrentTimeZone
        DaylightInEffect = objCompSysItem.DaylightInEffect
        TotalMemory = FormatNumber(objCompSysItem.TotalPhysicalMemory/1024^3, 2)
    Next

'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'//
'// Set variables gathered from Win32_TimeZone class:

    For Each objTZItem in colTZItems
        TZName = objTZItem.StandardName
    Next

'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'//
'// Set variables gathered from Win32_ComputerSystemProduct class:

    For Each objCompSysProdItem in colCompSysProdItems
        CompSysName = objCompSysProdItem.Name
        IdentifyingNumber = objCompSysProdItem.IdentifyingNumber
        UUID = objCompSysProdItem.UUID
    Next

'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'//
'// Set variables gathered from Win32_BIOS class:

    For Each objBIOSItem in colBIOSItems
        SMBIOSVersion = objBIOSItem.SMBIOSBIOSVersion
    Next

'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'//
'// Start echoing output to the screen

    Wscript.Echo "     ------------------------------------------"
    Wscript.Echo "                   System Details"
    Wscript.Echo "     ------------------------------------------"
    Wscript.Echo ""
    Wscript.Echo "     Computer Name:        " & CSName
    Wscript.Echo ""
    Wscript.Echo ""
    Wscript.Echo "     Operating System Information:"
    Wscript.Echo "     ============================="
    Wscript.Echo "     Operating System:     " & Caption & Arch
    Wscript.Echo "     Version:               " & Version & " " & Sku & " " & CSDVersion
    Wscript.Echo "     Build Type:            " & BuildType
    Wscript.Echo "     Locale:                " & Locale
    Wscript.Echo "     Serial Number:         " & SerialNumber
    Wscript.Echo ""
    Wscript.Echo "     Current Time Zone:     " & TZName
    Wscript.Echo "     Offset from UTC:       " & CurrentTimeZone/60 & " hours"
    Wscript.Echo "     DST In Effect:         " & DaylightInEffect
    Wscript.Echo ""

'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'//
'// Get the product keys (function at the end of script):

GetKeys()

    Wscript.Echo ""
    Wscript.Echo "     Install Date:          " & InstallDate
    Wscript.Echo "     Last Boot Time:        " & LastBootUpTime
    Wscript.Echo "     Local Date/Time:       " & Now()
    Wscript.Echo ""
    Wscript.Echo "     System Status:         " & Status
    Wscript.Echo ""
    Wscript.Echo ""
    Wscript.Echo "     Hardware Information:"
    Wscript.Echo "     ====================="

'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'//
'// Set and echo variables gathered from Win32_Processor class:

    For Each objProcItem in colProcItems
        Select Case objProcItem.Architecture
            Case 0 CPUArch = "x86"
            Case 1 CPUArch = "MIPS"
            Case 2 CPUArch = "Alpha"
            Case 3 CPUArch = "PowerPC"
            Case 6 CPUArch = "Itanium"
            Case 9 CPUArch = "x64"
            Case Else
            CPUArch = "Could Not Determine CPU Architecture"
        End Select
    Wscript.Echo "     CPU:                  " & objProcItem.Name & " (" & CPUArch & ")"
    Next
    Wscript.Echo ""
    Wscript.Echo "     Physical Memory:      " & TotalMemory & " GB"
    Wscript.Echo ""

'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'//
'// Set variables gathered from Win32_VideoController class:

    For Each objVideoItem in colVideoItems
        Wscript.Echo "     Video Card:           " & objVideoItem.Name

        If Not objVideoItem.AdapterDACType = "" Then
            Wscript.Echo "     Adapter DAC:           " & objVideoItem.AdapterDACType
        End if

        Wscript.Echo "     PNP Device ID:         " & objVideoItem.PNPDeviceID

        If Not objVideoItem.AdapterRAM = "" Then
            Wscript.Echo "     Video RAM:             " & objVideoItem.AdapterRAM/1024^2 & " MB"
        End If

        Wscript.Echo "     Driver Version:        " & objVideoItem.DriverVersion

        On Error Resume Next
        ScriptHelper.SWbemDateTime.Value = objVideoItem.DriverDate
            If Err.number <> 0 Then
                DriverDate = ""
                ' No DriverDate, do not echo
            Else
                DriverDate = ScriptHelper.SWbemDateTime.GetVarDate(False)
                Wscript.Echo "     Driver Date:           " & DriverDate
            End If
        On Error Goto 0
        Wscript.Echo ""
    Next

'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'//
'// Set variables gathered from Win32_SoundDevice class:

    For Each objSoundItem in colSoundItems
        Wscript.Echo "     Sound Card:           " & objSoundItem.Name
        Wscript.Echo "     Manufacturer:          " & objSoundItem.Manufacturer
        Wscript.Echo "     PNP Device ID:         " & objSoundItem.PNPDeviceID
        Wscript.Echo ""
    Next

'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'//
'// Set variables gathered from Win32_LogicalDisk class:

    For Each objDiskItem in colDiskItems
        If objDiskItem.DriveType = 3 Then
            Wscript.Echo "     Volume:               " & objDiskItem.Caption
            Wscript.Echo "     Compressed:            " & objDiskItem.Compressed
            Wscript.Echo "     File System:           " & objDiskItem.FileSystem
            Wscript.Echo "     Volume Size:           " & FormatNumber(objDiskItem.Size/1024^3, 2) & " GB"
            Wscript.Echo "     Free Space:            " & FormatNumber(objDiskItem.FreeSpace/1024^3, 2) & " GB"
            Wscript.Echo ""
        End If
    Next

'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'//
'// Set variables gathered from Win32_NetworkAdapterConfiguration class:

    For Each objNetAdapConfigItem in colNetAdapConfigItems
        If isNull(objNetAdapConfigItem.IPAddress) Then
            '// Skip adapter, not currently used
        Else
            Wscript.Echo "     Network Adapter:      " & objNetAdapConfigItem.Description
            Wscript.Echo "     MAC Address:           " & objNetAdapConfigItem.MACAddress
            Wscript.Echo "     DHCP Enabled:          " & objNetAdapConfigItem.DHCPEnabled
            Wscript.Echo "     IP Address:            " & Join(objNetAdapConfigItem.IPAddress, ",")
            Wscript.Echo "     Subnet Mask:           " & Join(objNetAdapConfigItem.IPSubnet, ",")
            Wscript.Echo "     Default Gateway:       " & Join(objNetAdapConfigItem.DefaultIPGateway, ",")
            If objNetAdapConfigItem.DHCPEnabled = True Then

                ScriptHelper.SWbemDateTime.Value = objNetAdapConfigItem.DHCPLeaseObtained
                DHCPLeaseObtained = ScriptHelper.SWbemDateTime.GetVarDate(True)
                Wscript.Echo "     Lease Obtained:        " & DHCPLeaseObtained

                ScriptHelper.SWbemDateTime.Value = objNetAdapConfigItem.DHCPLeaseExpires
                DHCPLeaseExpires = ScriptHelper.SWbemDateTime.GetVarDate(True)
                Wscript.Echo "     Lease Exipres:         " & DHCPLeaseExpires

                Wscript.Echo "     DHCP Servers:          " & objNetAdapConfigItem.DHCPServer
            End If
            Wscript.Echo "     DNS Server:            " & Join(objNetAdapConfigItem.DNSServerSearchOrder, ",")
            If Not objNetAdapConfigItem.WINSPrimaryServer = "" Then
                Wscript.Echo "     WINS Primary Server:   " & objNetAdapConfigItem.WINSPrimaryServer
                If Not objNetAdapConfigItem.WINSSecondaryServer = "" Then
                    Wscript.Echo "     WINS Secondary Server: " & objNetAdapConfigItem.WINSPrimaryServer
                End If
                Wscript.Echo "     Enable LMHosts Lookup: " & objNetAdapConfigItem.WINSEnableLMHostsLookup
            End If
            Wscript.Echo ""
        End If
    Next
    Wscript.Echo ""
    Wscript.Echo "     System Information:"
    Wscript.Echo "     ==================="
    Wscript.Echo "     Computer:             " & CompSysName
    Wscript.Echo "     Serial Number:         " & IdentifyingNumber
    Wscript.Echo "     BIOS Version:          " & SMBIOSVersion
    Wscript.Echo "     UUID:                  " & UUID
    Wscript.Echo ""

'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'//
'// This pause call is disabled, but you may wish to enable it if running this script
'// with the ElevateThisScript() subroutine call enabled above:

' PressEnter()

'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'//
'// Functions: GetKeys() and decodeKey(iValues, strProduct)
'//
'// Credit where credit is due - I found and modified script posted by user "Parabellum"
'// found on http://www.visualbasicscript.com/m42793.aspx, hacked it up a bit, and used
'// it here to post keys:

Public Function GetKeys()

    For x = LBound(arrSubKeys, 1) To UBound(arrSubKeys, 1)
    ScriptHelper.Registry.GetBinaryValue HKEY_LOCAL_MACHINE, arrSubKeys(x,1), SEARCH_KEY, arrDPIDBytes

        If Not IsNull(arrDPIDBytes) Then
            Call decodeKey(arrDPIDBytes, arrSubKeys(x,0))
        Else
            ScriptHelper.Registry.EnumKey HKEY_LOCAL_MACHINE, arrSubKeys(x,1), arrGUIDKeys

            If Not IsNull(arrGUIDKeys) Then
                For Each GUIDKey In arrGUIDKeys
                    ScriptHelper.Registry.GetBinaryValue HKEY_LOCAL_MACHINE, arrSubKeys(x,1) & "\" & GUIDKey, SEARCH_KEY, arrDPIDBytes

                    If Not IsNull(arrDPIDBytes) Then
                        Call decodeKey(arrDPIDBytes, arrSubKeys(x,0))
                    End If
                Next
            End If
        End If
    Next

End Function

    Public Function decodeKey(iValues, strProduct)

        Dim arrDPID
        arrDPID = Array()

            For i = 52 to 66
                ReDim Preserve arrDPID( UBound(arrDPID) + 1 )
                arrDPID( UBound(arrDPID) ) = iValues(i)
            Next

        Dim arrChars
        arrChars = Array("B","C","D","F","G","H","J","K","M","P","Q","R","T","V","W","X","Y","2","3","4","6","7","8","9")

            For i = 24 To 0 Step -1
                k = 0

                For j = 14 To 0 Step -1
                    k = k * 256 Xor arrDPID(j)
                    arrDPID(j) = Int(k / 24)
                    k = k Mod 24
                Next

                strProductKey = arrChars(k) & strProductKey

                If i Mod 5 = 0 And i <> 0 Then
                    strProductKey = "-" & strProductKey
                End If
            Next

        ReDim Preserve foundKeys( UBound(foundKeys) + 1 )
        foundKeys( UBound(foundKeys) ) = strProductKey
        strKey = UBound(foundKeys)
        Wscript.Echo "     " & strProduct & "" & foundKeys(strKey)
    End Function

'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'//
'// Subroutine: PressEnter()
'//
'// Adds a pause with a "Press the ENTER key to continue." message when called.
'//
'// Usage:  Call this Subroutine to get a pause that will clear when the user presses the
'// ENTER key (and ONLY the ENTER key) on their keyboard:

Sub PressEnter()
    Wscript.Echo ""
    strMessage = "Press the ENTER key to continue. "
    Wscript.StdOut.Write strMessage

    Do While Not WScript.StdIn.AtEndOfLine
        Input = WScript.StdIn.Read(1)
    Loop
End Sub

'// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'//
'// ScriptHelperClass and EnvironmentClass are helper classes to simplify
'// script work. Declare and use globally throughout the script.
'//
'//     Example code:
'//
'//     Option Explicit
'//     Dim ScriptHelper
'//     Set ScriptHelper = New ScriptHelperClass
'//     ScriptHelper.RunMeWithCScript()
'//     ScriptHelper.ElevateThisScript()
'//     WScript.Echo "User profile : " & ScriptHelper.Environment.UserProfile
'//     WScript.Echo "Domain : " & ScriptHelper.Network.UserDomain
'//     ScriptHelper.CreateFolder "\\SERVER\Share\Folder\With\Path"
'//     ScriptHelper.FileSystem.FileExists("C:\command.com")
'//     ScriptHelper.Shell.RegRead("HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\ProductOptions\ProductType")
'//
'// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Class ScriptHelperClass

        Private objEnvironment
        Private objFileSystem
        Private objNetwork
        Private objShell
        Private objSWBemlocator
        Private objWMI
        Private objRegistry
        Private objSWbemDateTime

        Public Computer

        Public Property Get Environment
            If objEnvironment Is Nothing Then
                Set objEnvironment = New EnvironmentClass
                objEnvironment.Shell = Shell
            End If
            Set Environment = objEnvironment
        End Property

        Public Property Get FileSystem
            If objFileSystem Is Nothing Then Set objFileSystem = CreateObject("Scripting.FileSystemObject")
            Set FileSystem = objFileSystem
        End Property

        Public Property Get Network
            If objNetwork Is Nothing Then Set objNetwork = CreateObject("WScript.Network")
            Set Network = objNetwork
        End Property

        Public Property Get Shell
            If objShell Is Nothing Then Set objShell = CreateObject("WScript.Shell")
            Set Shell = objShell
        End Property

        Public Property Get WMI
            If objWMI Is Nothing Then
                On Error Resume Next
                Set objSWBemlocator = CreateObject("WbemScripting.SWbemLocator")
                Set objWMI = objSWBemlocator.ConnectServer(Computer, "root\CIMV2")
                objWMI.Security_.ImpersonationLevel = 3
                On Error Goto 0
            End If
            Set WMI = objWMI
        End Property

        Public Property Get Registry
            If objRegistry Is Nothing Then Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
            Set Registry = objRegistry
        End Property

        Public Property Get SWbemDateTime
            If objSWbemDateTime Is Nothing Then Set objSWbemDateTime = CreateObject("WbemScripting.SWbemDateTime")
            Set SWbemDateTime = objSWbemDateTime
        End Property

        Private Sub Class_Initialize()
            Computer = "."
            Set objEnvironment = Nothing
            Set objFileSystem = Nothing
            Set objNetwork = Nothing
            Set objShell = Nothing
            Set objSWBemlocator = Nothing
            Set objWMI = Nothing
            Set objRegistry = Nothing
            Set objSWbemDateTime = Nothing
        End Sub

        Private Sub Class_Terminate
            Set objSWbemDateTime = Nothing
            Set objRegistry = Nothing
            Set objWMI = Nothing
            Set objSWBemlocator = Nothing
            Set objShell = Nothing
            Set objNetwork = Nothing
            Set objFileSystem = Nothing
            Set objEnvironment = Nothing
        End Sub

        Public Property Get ScriptPath()
            ScriptPath = FileSystem.GetFile(WScript.ScriptFullName).ParentFolder
        End Property

        Public Function GetCurrentUserSID()
            Dim intCount, colItems, objItem, strSID

            Set colItems = WMI.ExecQuery("SELECT * FROM Win32_UserAccount WHERE Name = '" & Network.Username & "' AND Domain = '" & Network.UserDomain & "'", , 48)

            intCount = 0
            For Each objItem In colItems
                strSID = Cstr(objItem.SID)
                intCount = intCount + 1
            Next

            If intCount > 0 Then
                GetCurrentUserSID = strSID
            Else
                GetCurrentUserSID = "NOTFOUND"
            End If
        End Function

        Public Sub CreateFolder(strFldPath)
            Dim fldArray, x, intStartIndex, blnUNC, strDestFold : strDestFold = ""

            If Left(strFldPath, 2) = "\\"  Then
                blnUNC = True
                intStartIndex = 3                                        'Start at the first folder in UNC path
            Else
                blnUNC = False
                intStartIndex = 0
            End If

            fldArray = Split(strFldPath, "\")                                                        'Split folders into array

            If fldArray(intStartIndex) = "" Then Exit Sub

            For x = intStartIndex To UBound(fldArray)

                If strDestFold = "" Then
                    If blnUNC Then
                        strDestFold = "\\" & fldArray(x-1) & "\" & fldArray(x)                    'Prefix UNC with server and share
                    Else
                        strDestFold = fldArray(x)
                    End If
                Else
                    strDestFold = strDestFold & "\" & fldArray(x)                                'Append each folder to end of path
                End If

                If Not FileSystem.FolderExists(strDestFold) Then FileSystem.CreateFolder(strDestFold)
            Next
        End Sub

        Public Sub DeleteFolder(strFldPath)
            If FileSystem.FolderExists(strFldPath) Then FileSystem.DeleteFolder strFldPath, True
        End Sub

        '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        '// Subroutine: RunMeWithCScript()
        '//
        '// Purpose:    Forces the currently running script to use Cscript.exe as the Script
        '//             engine.  If the script is already running with cscript.exe the sub exits
        '//             and continues the script.
        '//
        '//             Sub Attempts to call the script with its original arguments.  Arguments
        '//             that contain a space will be wrapped in double quotes when the script
        '//             calls itself again.  To verify your command string you can echo out the
        '//             scriptCommand variable.
        '//
        '// Usage:      Add a call to this sub (RunMeWithCscript) to the beggining of your script
        '//             to ensure that cscript.exe is used as the script engine.
        '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        Public Sub RunMeWithCScript()

            Dim scriptEngine, engineFolder, Args, arg, scriptName, argString, scriptCommand

            scriptEngine = Ucase(Mid(Wscript.FullName,InstrRev(Wscript.FullName,"\")+1))
            engineFolder = Left(Wscript.FullName,InstrRev(Wscript.FullName,"\"))
            argString = ""

            If scriptEngine = "WSCRIPT.EXE" Then
                Dim Shell : Set Shell = CreateObject("Wscript.Shell")
                Set Args = Wscript.Arguments

                For each arg in Args                        'loop though argument array as a collection to rebuild argument string
                    If instr(arg," ") > 0 Then arg = """" & arg & """"    'if the argument contains a space wrap it in double quotes
                    argString = argString & " " & Arg
                Next

                'Create a persistent command prompt for the cscript output window and call the script with its original arguments
                scriptCommand = "cmd.exe /k " & engineFolder & "cscript.exe """ & Wscript.ScriptFullName & """" & argString

                Shell.Run scriptCommand,,False
                Wscript.Quit
            Else
                Exit Sub                    'Already Running with Cscript Exit this Subroutine
            End If

        End Sub

        '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        '// Subroutine: ElevateThisScript()
        '//
        '// Purpose:    (Intended for Vista+)
        '//             Forces the currently running script to prompt for UAC elevation if it
        '//             detects that the current user credentials do not have administrative
        '//             privileges.
        '//
        '//             If run on Windows XP this script will cause the RunAs dialog to appear if
        '//             the user does not have administrative rights, giving the opportunity to
        '//             run as an administrator.
        '//
        '//             This Sub Attempts to call the script with its original arguments.
        '//             Arguments that contain a space will be wrapped in double quotes when the
        '//             script calls itself again.
        '//
        '// Usage:      Add a call to this sub (ElevateThisScript) to the beginning of your
        '//             script to ensure that the script gets an administrative token.
        '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        Public Sub ElevateThisScript()

            Const HKEY_CLASSES_ROOT  = &H80000000
            Const HKEY_CURRENT_USER  = &H80000001
            Const HKEY_LOCAL_MACHINE = &H80000002
            Const HKEY_USERS         = &H80000003
            const KEY_QUERY_VALUE      = 1
            Const KEY_SET_VALUE          = 2

            Dim scriptEngine, engineFolder, argString, arg, Args, scriptCommand, HasRequiredRegAccess
            Dim objShellApp : Set objShellApp = CreateObject("Shell.Application")

            scriptEngine = Ucase(Mid(Wscript.FullName,InstrRev(Wscript.FullName,"\")+1))
            engineFolder = Left(Wscript.FullName,InstrRev(Wscript.FullName,"\"))
            argString = ""

            Set Args = Wscript.Arguments

            For each arg in Args                        'loop though argument array as a collection to rebuild argument string
                If instr(arg," ") > 0 Then arg = """" & arg & """"    'if the argument contains a space wrap it in double quotes
                argString = argString & " " & Arg
            Next

            scriptCommand = engineFolder & scriptEngine

            Dim objReg, bHasAccessRight
            Set objReg=GetObject("winmgmts:"_
                & "{impersonationLevel=impersonate}!\\" &_
                Computer & "\root\default:StdRegProv")

            'Check for administrative registry access rights
            objReg.CheckAccess HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Control\CrashControl", _
                KEY_SET_VALUE, bHasAccessRight

            If bHasAccessRight = True Then

                HasRequiredRegAccess = True
                Exit Sub

            Else

                HasRequiredRegAccess = False
                objShellApp.ShellExecute scriptCommand, " """ & Wscript.ScriptFullName & """" & argString, "", "runas"
                WScript.Quit
            End If

        End Sub
    End Class

    Class EnvironmentClass
        Private objShell
        Private strLogonServer
        Private strProgramFiles
        Private strProgramFilesX86
        Private strUserProfile
        Private strWinDir

        Public Cache

        Public Property Let Shell(objParentShell)
            Set objShell = objParentShell
        End Property

        Public Property Get LogonServer
            If IsNull(strLogonServer) Or Cache = False Then strLogonServer = objShell.ExpandEnvironmentStrings("%LOGONSERVER%")
            LogonServer = strLogonServer
        End Property

        Public Property Get ProgramFiles
            If IsNull(strProgramFiles) Or Cache = False Then strProgramFiles = objShell.ExpandEnvironmentStrings("%PROGRAMFILES%")
            ProgramFiles = strProgramFiles
        End Property

        Public Property Get ProgramFilesX86
            If IsNull(strProgramFilesX86) Or Cache = False Then strProgramFilesX86 = objShell.ExpandEnvironmentStrings("%PROGRAMFILES(x86)%")
            ProgramFilesX86 = strProgramFilesX86
        End Property

        Public Property Get UserProfile
            If IsNull(strUserProfile) Or Cache = False Then strUserProfile = objShell.ExpandEnvironmentStrings("%USERPROFILE%")
            UserProfile = strUserProfile
        End Property

        Public Property Get WinDir
            If IsNull(strWinDir) Or Cache = False Then strWinDir = objShell.ExpandEnvironmentStrings("%WINDIR%")
            WinDir = strWinDir
        End Property

        Private Sub Class_Initialize()
            Cache = True
            strLogonServer = Null
            strProgramFiles = Null
            strProgramFilesX86 = Null
            strUserProfile = Null
            strWinDir = Null
        End Sub
    End Class
Categories: Scripts, Windows Tags:
  1. tain
    December 27th, 2009 at 06:28 | #1

    Neat! It has some quirks and doesn’t work for me 100% but is a nice template and should be fun to tinker with when I get some free time. Thanks!

  2. cluberti
    December 28th, 2009 at 01:30 | #2

    @tain
    I tried my darndest to use WMI Class members that worked from W2K on up, but unfortunately WMI in W2K can be… lacking in areas compared to even XP. With that in mind, some of these things are known not to work on W2K, and some may even not entirely work on XP (I’ve since moved to Vista and Win7 in most places, so I didn’t really test the additions there; mostly this was built and tested in a Win7 environment – if I get a chance this week I’ll be running the changes down in Vista and XP to see what happens, so I may update this again, but I wouldn’t count on it). Obviously, feel free to add your own If statements to check the objOSItem.BuildNumber if you want to skip portions on OSes that don’t work (if you find something doesn’t work, look up the WMI class on MSDN to see if that member is supported on your OS of choice).

    I’ve updated it to add some of the additional info previously asked for by someone on another forum (specifically video, audio, and network/IP info).

  3. tain
    December 28th, 2009 at 06:34 | #3

    I run it under XP, but of course my box is nLited. That’s why I haven’t posted any specific issues. They are likely my own fault :) I’ll put some brain power on it one of these days.

    And thanks for the update!

  4. cluberti
    December 28th, 2009 at 18:53 | #4

    Updated again to check Office product keys.

  5. cluberti
    January 15th, 2010 at 23:17 | #5

    Updated again – script should be much faster, and find keys with the latest versions of Office 2010 out there that store keys in random GUID locations now.

  6. sanits591
    March 23rd, 2011 at 06:20 | #6

    I need to import the output of this VB Script to excel, request to provide or incorporate the code for this.

    Any help in this regard shall be highly appreciated

  7. ryan
    April 24th, 2012 at 23:09 | #7

    I have your previous version, which i have done a major modification to also detect default printer and its port connected to, then export into HTML and with the submit of the button it will be imported to my inventory system database in phpmyadmin via WAMP server. I have also designed my inventory system to have the records of switches, ports, connected devices, and devices status.

    I was wondering if This script (updated) will detect any/all ms Office that has been installed? Let say if a PC is installed with more than 1 MS office version (office 2003 & office 2007) will it detect both the offices and its serials?

  8. ryan
    April 24th, 2012 at 23:43 | #8

    You know what, actually i have done major tweaking to your previous script to echo html tags, and other scripts to include monitor brand, model,serial.

    The problem is how do i add on just the portion of MS Office 2010 serial finder into your previous code? Could you kindly help me out if i provide you my version of the script?

  9. ryan
    April 25th, 2012 at 02:52 | #9

    Parabellum,

    I have your previous code (last update Dec-28-2009).
    I have done major tweak to it to meet my needs. The only issue is that it does not capture the serials for Office 2010. And i really do not know where to start as your current scripts does not match the previous script. In addition to that I have made the script to output to HTML then it updates the database (phpmyadmin) via WAMP. No problem in the updates and outputs..

    Could you kindly make the changes to capture MS office 2010 on my behalf? I have the codes.

    '// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '//
    '// NAME:        osinfo.vbs
    '//
    '// Original:    http://www.cluberti.com/blog
    '// Last Update: 28th December 2009
    '//
    '// Comment:     VBS example file for use as an OS info gathering template.
    '//
    '// NOTE:        Provided as-is - usage of this source assumes that you are at the
    '//              very least familiar with the vbscript language being used and
    '//              the tools used to create and debug this file.
    '//
    '//              In other words, if you break it, you get to keep the pieces.
    '//
    '//              Also, if you want to use this on W2K, prepare to hack, as this
    '//              was really designed with XP+ systems in mind.
    '//
    '// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    '***** HACKED*****
    '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ progress bar function ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Function ProgressMsg( strMessage, strWindowTitle )
    ' Written by Denis St-Pierre
    ' Displays a progress message box that the originating script can kill in both 2k and XP
    ' If StrMessage is blank, take down previous progress message box
    ' Using 4096 in Msgbox below makes the progress message float on top of things
    ' CAVEAT: You must have   Dim ObjProgressMsg   at the top of your script for this to work as described
        Set wshShell = WScript.CreateObject( "WScript.Shell" )
        strTEMP = wshShell.ExpandEnvironmentStrings( "%TEMP%" )
        If strMessage = "" Then
            ' Disable Error Checking in case objProgressMsg doesn't exists yet
            On Error Resume Next
            ' Kill ProgressMsg
            objProgressMsg.Terminate( )
            ' Re-enable Error Checking
            On Error Goto 0
            Exit Function
        End If
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        strTempVBS = strTEMP + "\" & "Message.vbs"     'Control File for reboot
    
        ' Create Message.vbs, True=overwrite
        Set objTempMessage = objFSO.CreateTextFile( strTempVBS, True )
        objTempMessage.WriteLine( "MsgBox""" & strMessage & """, 4096, """ & strWindowTitle & """" )
        objTempMessage.Close
    
        ' Disable Error Checking in case objProgressMsg doesn't exists yet
        On Error Resume Next
        ' Kills the Previous ProgressMsg
        objProgressMsg.Terminate( )
        ' Re-enable Error Checking
        On Error Goto 0
    
        ' Trigger objProgressMsg and keep an object on it
        Set objProgressMsg = WshShell.Exec( "%windir%\system32\wscript.exe " & strTempVBS )
    
        Set wshShell = Nothing
        Set objFSO   = Nothing
    End Function
    '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~end of progress bar function ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '//
    '// This script will require elevated privileges if run from a non-admin account, so
    '// calling the ElevateThisScript() Sub should get the script a full admin token. This is
    '// currently disabled, but if you need non-admin users to run this script, enable the
    '// call to this subroutine to pop-up a dialog box (they'll of course need administrative
    '// credentials to put in the challenge dialog before the script will execute with an
    '// administrative token):
    
    ' ElevateThisScript()
    
    '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '//
    '// Set variables and wMI connections for scripting against:
    CONST HKEY_LOCAL_MACHINE = &H80000002
    CONST SEARCH_KEY = "DigitalProductID"
    Dim arrSubKeys(4,1)
    Dim foundKeys
    dim MSType1, MSType, strWindowTitle
    Dim objProgressMsg
    
    Dim iValues, arrDPID
    foundKeys = Array()
    iValues = Array()
    arrSubKeys(0,0) = "Windows PID Key:       "
    arrSubKeys(0,1) = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"
    arrSubKeys(2,0) = "Office XP PID Key:     "
    arrSubKeys(2,1) = "SOFTWARE\Microsoft\Office\10.0\Registration"
    arrSubKeys(1,0) = "Office 2003 PID Key:   "
    arrSubKeys(1,1) = "SOFTWARE\Microsoft\Office\11.0\Registration"
    arrSubKeys(3,0) = "Office 2007 PID Key:   "
    arrSubKeys(3,1) = "SOFTWARE\Microsoft\Office\12.0\Registration"
    arrSubKeys(4,0) = "Office 2010 PID Key:   "
    arrSubKeys(4,1) = "SOFTWARE\Microsoft\Office\14.0\Registration"
    
    strComputer = "."
    Arch = ""
    Sku = ""
    MSType1=""
    MSType=""
    strProgress=""
    
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
    Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
    Set objSWbemDateTime = CreateObject("WbemScripting.SWbemDateTime")
    
    Set colOSItems = objWMIService.ExecQuery( _
        "SELECT * FROM Win32_OperatingSystem",,48)
    
    Set colProcItems = objWMIService.ExecQuery( _
        "SELECT * FROM Win32_Processor",,48)
    
    Set colCompSysItems = objWMIService.ExecQuery( _
        "SELECT * FROM Win32_ComputerSystem",,48) 
    
    Set colTZItems = objWMIService.ExecQuery( _
        "SELECT * FROM Win32_TimeZone",,48) 
    
    Set colCompSysProdItems = objWMIService.ExecQuery( _
        "SELECT * FROM Win32_ComputerSystemProduct",,48)
    
    Set colBIOSItems = objWMIService.ExecQuery( _
        "SELECT * FROM Win32_BIOS",,48)
    
    Set colDiskItems = objWMIService.ExecQuery( _
        "SELECT * FROM Win32_LogicalDisk",,48) 
    
    Set colNetAdapConfigItems = objWMIService.ExecQuery( _
        "SELECT * FROM Win32_NetworkAdapterConfiguration",,48) 
    
    Set colVideoItems = objWMIService.ExecQuery( _
        "SELECT * FROM Win32_VideoController",,48) 
    
    Set colSoundItems = objWMIService.ExecQuery( _
        "SELECT * FROM Win32_SoundDevice",,48) 
    
    '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '//
    '// Get OS SKU from Win32_OperatingSystem class:
    
        For Each objOSItem in colOSItems
        If objOSItem.BuildNumber => 6000 Then
            Arch = objOSItem.OSArchitecture
    
            Select Case objOSItem.OperatingSystemSKU
                Case 0 Sku = "Unknown Windows version"
                Case 1 Sku = "Ultimate Edition"
                Case 2 Sku = "Home Basic Edition"
                Case 3 Sku = "Home Premium Edition"
                Case 4 Sku = "Enterprise Edition"
                Case 5 Sku = "Home Basic N Edition"
                Case 6 Sku = "Business Edition"
                Case 7 Sku = "Standard Server Edition"
                Case 8 Sku = "Datacenter Server Edition"
                Case 9 Sku = "Small Business Server Edition"
                Case 10 Sku = "Enterprise Server Edition"
                Case 11 Sku = "Starter Edition"
                Case 12 Sku = "Datacenter Server Core Edition"
                Case 13 Sku = "Standard Server Core Edition"
                Case 14 Sku = "Enterprise Server Core Edition"
                Case 15 Sku = "Enterprise Server Edition for Itanium-Based Systems"
                Case 16 Sku = "Business N Edition"
                Case 17 Sku = "Web Server Edition"
                Case 18 Sku = "Cluster Server Edition"
                Case 19 Sku = "Home Server Edition"
                Case 20 Sku = "Storage Express Server Edition"
                Case 21 Sku = "Storage Standard Server Edition"
                Case 22 Sku = "Storage Workgroup Server Edition"
                Case 23 Sku = "Storage Enterprise Server Edition"
                Case 24 Sku = "Server For Small Business Edition"
                Case 25 Sku = "Small Business Server Premium Edition"
                Case Else
                Sku = "Could Not Determine Operating System SKU"
            End Select
        End If
    
    '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '//
    '// Get current OS locale setting from Win32_OperatingSystem class:
    
            Select Case objOSItem.Locale
                Case 0436 Locale = "Afrikaans (South Africa)"
                Case 041c Locale = "Albanian (Albania)"
                ' Case 045e Locale = "Amharic (Ethiopia)"
                Case 0401 Locale = "Arabic (Saudi Arabia)"
                Case 1401 Locale = "Arabic (Algeria)"
                Case 3c01 Locale = "Arabic (Bahrain)"
                Case 0c01 Locale = "Arabic (Egypt)"
                Case 0801 Locale = "Arabic (Iraq)"
                Case 2c01 Locale = "Arabic (Jordan)"
                Case 3401 Locale = "Arabic (Kuwait)"
                Case 3001 Locale = "Arabic (Lebanon)"
                Case 1001 Locale = "Arabic (Libya)"
                Case 1801 Locale = "Arabic (Morocco)"
                Case 2001 Locale = "Arabic (Oman)"
                Case 4001 Locale = "Arabic (Qatar)"
                Case 2801 Locale = "Arabic (Syria)"
                Case 1c01 Locale = "Arabic (Tunisia)"
                Case 3801 Locale = "Arabic (U.A.E.)"
                Case 2401 Locale = "Arabic (Yemen)"
                Case 042b Locale = "Armenian (Armenia)"
                Case 044d Locale = "Assamese"
                Case 082c Locale = "Azeri (Cyrillic)"
                Case 042c Locale = "Azeri (Latin)"
                Case 042d Locale = "Basque"
                Case 0423 Locale = "Belarusian"
                Case 0445 Locale = "Bengali (India)"
                Case 0845 Locale = "Bengali (Bangladesh)"
                Case 141A Locale = "Bosnian (Bosnia/Herzegovina)"
                Case 0402 Locale = "Bulgarian"
                Case 0455 Locale = "Burmese"
                Case 0403 Locale = "Catalan"
                Case 045c Locale = "Cherokee (United States)"
                Case 0804 Locale = "Chinese (PRC)"
                Case 1004 Locale = "Chinese (Singapore)"
                Case 0404 Locale = "Chinese (Taiwan)"
                Case 0c04 Locale = "Chinese (Hong Kong SAR)"
                Case 1404 Locale = "Chinese (Macao SAR)"
                Case 041a Locale = "Croatian"
                Case 101a Locale = "Croatian (Bosnia/Herzegovina)"
                Case 0405 Locale = "Czech"
                Case 0406 Locale = "Danish"
                Case 0465 Locale = "Divehi"
                Case 0413 Locale = "Dutch (Netherlands)"
                Case 0813 Locale = "Dutch (Belgium)"
                Case 0466 Locale = "Edo"
                Case 0409 Locale = "English (United States)"
                Case 0809 Locale = "English (United Kingdom)"
                Case 0c09 Locale = "English (Australia)"
                Case 2809 Locale = "English (Belize)"
                Case 1009 Locale = "English (Canada)"
                Case 2409 Locale = "English (Caribbean)"
                Case 3c09 Locale = "English (Hong Kong SAR)"
                Case 4009 Locale = "English (India)"
                Case 3809 Locale = "English (Indonesia)"
                Case 1809 Locale = "English (Ireland)"
                Case 2009 Locale = "English (Jamaica)"
                Case 4409 Locale = "English (Malaysia)"
                Case 1409 Locale = "English (New Zealand)"
                Case 3409 Locale = "English (Philippines)"
                Case 4809 Locale = "English (Singapore)"
                Case 1c09 Locale = "English (South Africa)"
                Case 2c09 Locale = "English (Trinidad)"
                Case 3009 Locale = "English (Zimbabwe)"
                Case 0425 Locale = "Estonian"
                Case 0438 Locale = "Faroese"
                Case 0429 Locale = "Farsi"
                Case 0464 Locale = "Filipino"
                Case 040b Locale = "Finnish"
                Case 040c Locale = "French (France)"
                Case 080c Locale = "French (Belgium)"
                Case 2c0c Locale = "French (Cameroon)"
                Case 0c0c Locale = "French (Canada)"
                Case 240c Locale = "French (DRC)"
                Case 300c Locale = "French (Cote d'Ivoire)"
                Case 3c0c Locale = "French (Haiti)"
                Case 140c Locale = "French (Luxembourg)"
                Case 340c Locale = "French (Mali)"
                Case 180c Locale = "French (Monaco)"
                Case 380c Locale = "French (Morocco)"
                Case e40c Locale = "French (North Africa)"
                Case 200c Locale = "French (Reunion)"
                Case 280c Locale = "French (Senegal)"
                Case 100c Locale = "French (Switzerland)"
                Case 1c0c Locale = "French (West Indies)"
                Case 0462 Locale = "Frisian (Netherlands)"
                Case 0467 Locale = "Fulfulde (Nigeria)"
                Case 042f Locale = "FYRO Macedonian"
                Case 083c Locale = "Gaelic (Ireland)"
                Case 043c Locale = "Gaelic (Scotland)"
                Case 0456 Locale = "Galician"
                Case 0437 Locale = "Georgian"
                Case 0407 Locale = "German (Germany)"
                Case 0c07 Locale = "German (Austria)"
                Case 1407 Locale = "German (Liechtenstein)"
                Case 1007 Locale = "German (Luxembourg)"
                Case 0807 Locale = "German (Switzerland)"
                Case 0408 Locale = "Greek"
                Case 0474 Locale = "Guarani (Paraguay)"
                Case 0447 Locale = "Gujarati"
                Case 0468 Locale = "Hausa (Nigeria)"
                Case 0475 Locale = "Hawaiian (United States)"
                Case 040d Locale = "Hebrew"
                Case 0439 Locale = "Hindi"
                ' Case 040e Locale = "Hungarian"
                Case 0469 Locale = "Ibibio (Nigeria)"
                Case 040f Locale = "Icelandic"
                Case 0470 Locale = "Igbo (Nigeria)"
                Case 0421 Locale = "Indonesian"
                Case 045d Locale = "Inuktitut"
                Case 0410 Locale = "Italian (Italy)"
                Case 0810 Locale = "Italian (Switzerland)"
                Case 0411 Locale = "Japanese"
                Case 044b Locale = "Kannada"
                Case 0471 Locale = "Kanuri (Nigeria)"
                Case 0860 Locale = "Kashmiri"
                Case 0460 Locale = "Kashmiri (Arabic)"
                Case 043f Locale = "Kazakh"
                Case 0453 Locale = "Khmer"
                Case 0457 Locale = "Konkani"
                Case 0412 Locale = "Korean"
                Case 0440 Locale = "Kyrgyz (Cyrillic)"
                Case 0454 Locale = "Lao"
                Case 0476 Locale = "Latin"
                Case 0426 Locale = "Latvian"
                Case 0427 Locale = "Lithuanian"
                ' Case 043e Locale = "Malay (Malaysia)"
                ' Case 083e Locale = "Malay (Brunei Darussalam)"
                Case 044c Locale = "Malayalam"
                Case 043a Locale = "Maltese"
                Case 0458 Locale = "Manipuri"
                Case 0481 Locale = "Maori (New Zealand)"
                ' Case 044e Locale = "Marathi"
                Case 0450 Locale = "Mongolian (Cyrillic)"
                Case 0850 Locale = "Mongolian (Mongolian)"
                Case 0461 Locale = "Nepali"
                Case 0861 Locale = "Nepali (India)"
                Case 0414 Locale = "Norwegian (Bokmеl)"
                Case 0814 Locale = "Norwegian (Nynorsk)"
                Case 0448 Locale = "Oriya"
                Case 0472 Locale = "Oromo"
                Case 0479 Locale = "Papiamentu"
                Case 0463 Locale = "Pashto"
                Case 0415 Locale = "Polish"
                Case 0416 Locale = "Portuguese (Brazil)"
                Case 0816 Locale = "Portuguese (Portugal)"
                Case 0446 Locale = "Punjabi"
                Case 0846 Locale = "Punjabi (Pakistan)"
                Case 046B Locale = "Quecha (Bolivia)"
                Case 086B Locale = "Quecha (Ecuador)"
                Case 0C6B Locale = "Quecha (Peru)"
                Case 0417 Locale = "Rhaeto-Romanic"
                Case 0418 Locale = "Romanian"
                Case 0818 Locale = "Romanian (Moldava)"
                Case 0419 Locale = "Russian"
                Case 0819 Locale = "Russian (Moldava)"
                Case 043b Locale = "Sami (Lappish)"
                Case 044f Locale = "Sanskrit"
                Case 046c Locale = "Sepedi"
                Case 0c1a Locale = "Serbian (Cyrillic)"
                Case 081a Locale = "Serbian (Latin)"
                Case 0459 Locale = "Sindhi (India)"
                Case 0859 Locale = "Sindhi (Pakistan)"
                Case 045b Locale = "Sinhalese (Sri Lanka)"
                Case 041b Locale = "Slovak"
                Case 0424 Locale = "Slovenian"
                Case 0477 Locale = "Somali"
                ' Case 042e Locale = "Sorbian"
                Case 0c0a Locale = "Spanish (Spain - Modern Sort)"
                Case 040a Locale = "Spanish (Spain - Traditional Sort)"
                Case 2c0a Locale = "Spanish (Argentina)"
                Case 400a Locale = "Spanish (Bolivia)"
                Case 340a Locale = "Spanish (Chile)"
                Case 240a Locale = "Spanish (Colombia)"
                Case 140a Locale = "Spanish (Costa Rica)"
                Case 1c0a Locale = "Spanish (Dominican Republic)"
                Case 300a Locale = "Spanish (Ecuador)"
                Case 440a Locale = "Spanish (El Salvador)"
                Case 100a Locale = "Spanish (Guatemala)"
                Case 480a Locale = "Spanish (Honduras)"
                Case 580a Locale = "Spanish (Latin America)"
                Case 080a Locale = "Spanish (Mexico)"
                Case 4c0a Locale = "Spanish (Nicaragua)"
                Case 180a Locale = "Spanish (Panama)"
                Case 3c0a Locale = "Spanish (Paraguay)"
                Case 280a Locale = "Spanish (Peru)"
                Case 500a Locale = "Spanish (Puerto Rico)"
                Case 540a Locale = "Spanish (United States)"
                Case 380a Locale = "Spanish (Uruguay)"
                Case 200a Locale = "Spanish (Venezuela)"
                Case 0430 Locale = "Sutu"
                Case 0441 Locale = "Swahili"
                Case 041d Locale = "Swedish"
                Case 081d Locale = "Swedish (Finland)"
                Case 045a Locale = "Syriac"
                Case 0428 Locale = "Tajik"
                Case 045f Locale = "Tamazight (Arabic)"
                Case 085f Locale = "Tamazight (Latin)"
                Case 0449 Locale = "Tamil"
                Case 0444 Locale = "Tatar"
                Case 044a Locale = "Telugu"
                ' Case 041e Locale = "Thai"
                Case 0851 Locale = "Tibetan (Bhutan)"
                Case 0451 Locale = "Tibetan (PRC)"
                Case 0873 Locale = "Tigrigna (Eritrea)"
                Case 0473 Locale = "Tigrigna (Ethiopia)"
                Case 0431 Locale = "Tsonga"
                Case 0432 Locale = "Tswana"
                Case 041f Locale = "Turkish"
                Case 0442 Locale = "Turkmen"
                Case 0480 Locale = "Uighur (China)"
                Case 0422 Locale = "Ukrainian"
                Case 0420 Locale = "Urdu"
                Case 0820 Locale = "Urdu (India)"
                Case 0843 Locale = "Uzbek (Cyrillic)"
                Case 0443 Locale = "Uzbek (Latin)"
                Case 0433 Locale = "Venda"
                Case 042a Locale = "Vietnamese"
                Case 0452 Locale = "Welsh"
                Case 0434 Locale = "Xhosa"
                Case 0478 Locale = "Yi"
                Case 043d Locale = "Yiddish"
                Case 046a Locale = "Yoruba"
                Case 0435 Locale = "Zulu"
                Case 04ff Locale = "HID (Human Interface Device)"
                Case Else
                Locale = "Could Not Determine OS Locale"
            End Select
    
    strWindowTitle = "PC Audit - by Ryan"
    ProgressMsg "Initializing, Please wait ...", strWindowTitle
    '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '//
    '// Set variables gathered from Win32_OperatingSystem class:
    
            Caption = objOSItem.Caption
            CSDVersion = objOSItem.CSDVersion
            CSName = objOSItem.CSName
            Version = objOSItem.Version
            BuildType = objOSItem.BuildType
            BuildNumber = objOSItem.BuildNumber
            SerialNumber = objOSItem.SerialNumber
    
            objSWbemDateTime.Value = objOSItem.InstallDate
            InstallDate = objSWbemDateTime.GetVarDate(True)
    
            objSWbemDateTime.Value = objOSItem.LastBootUpTime
            LastBootUpTime = objSWbemDateTime.GetVarDate(True)
    
            Status = objOSItem.Status
        Next
    
    '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '//
    '// Set variables gathered from Win32_ComputerSystem class:
    
        For Each objCompSysItem in colCompSysItems
            CurrentTimeZone = objCompSysItem.CurrentTimeZone
            DaylightInEffect = objCompSysItem.DaylightInEffect
            TotalMemory = FormatNumber(objCompSysItem.TotalPhysicalMemory/1024^3, 2)
        Next
    
    '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '//
    '// Set variables gathered from Win32_TimeZone class:
    
        For Each objTZItem in colTZItems
            TZName = objTZItem.StandardName
        Next
    
    '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '//
    '// Set variables gathered from Win32_ComputerSystemProduct class:
    
        For Each objCompSysProdItem in colCompSysProdItems
            CompSysName = objCompSysProdItem.Name
            IdentifyingNumber = objCompSysProdItem.IdentifyingNumber
            UUID = objCompSysProdItem.UUID
        Next
    
    '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '//
    '// Set variables gathered from Win32_BIOS class:
    
        For Each objBIOSItem in colBIOSItems
            SMBIOSVersion = objBIOSItem.SMBIOSBIOSVersion
        Next
    
    '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    WScript.Sleep 3000
    
    '// Get the product keys (function at the end of script):
    
    ProgressMsg "Looking for License(s) Numbers...", strWindowTitle
    
    GetKeys() ' ################################################# remove the comment tag at the front - ryan
    WScript.Sleep 3000
    
     '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '//
    
    '// Set and echo variables gathered from Win32_Processor class:
    
    ProgressMsg "Gathering CPU details...", strWindowTitle
    
        For Each objProcItem in colProcItems
            Select Case objProcItem.Architecture
                Case 0 CPUArch = "x86"
                Case 1 CPUArch = "MIPS"
                Case 2 CPUArch = "Alpha"
                Case 3 CPUArch = "PowerPC"
                Case 6 CPUArch = "Itanium"
                Case 9 CPUArch = "x64"
                Case Else
                CPUArch = "Could Not Determine CPU Architecture"
            End Select
        CPUmsg = objProcItem.Name & " (" & CPUArch & ")" '################## DO NOT Delete this line - ryan
        Next
        RAMmsg = TotalMemory '################## DO NOT Delete this line - ryan
    WScript.Sleep 3000
    
    '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '//
    '//
    '// Set variables gathered from Win32_LogicalDisk class:
    logdisk=""
    ProgressMsg "Gathering HArd Disk details...", strWindowTitle
    
    DriveCount=0
        For Each objDiskItem in colDiskItems
            If objDiskItem.DriveType = 3 Then
                'logdisk = logdisk & "<tr><td>Drive :</td><td><input type=""text""  name=""Drive"" readonly=""readonly"" value=""" & objDiskItem.Caption & """></td></tr>" & vbCrLf
                'logdisk = logdisk & "<tr><td>File System:</td><td><input type=""text""  name=""           " & objDiskItem.FileSystem & vbCrLf
                logdisk = logdisk & "<tr><td>HDD Size:</td><td><input type=""text""  name=""HDD_Size"" readonly=""readonly"" value=""" & FormatNumber(objDiskItem.Size/1024^3, 2) & " GB"" ></td></tr>" & vbCrLf
                'logdisk = logdisk & "<tr><td>Free Space:            " & FormatNumber(objDiskItem.FreeSpace/1024^3, 2) & " GB" & vbCrLf
                         DriveCount = DriveCount + 1
                  if DriveCount > 0 Then Exit For
           End If
        Next
    WScript.Sleep 3000
    
    'MsgBox logdisk 
    
    '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    '// Set variables gathered from Win32_NetworkAdapterConfiguration class:
    
    ProgressMsg "Gathering Network details...", strWindowTitle
    
    ComputerDetail=""
    netmsg = "<tr><td colspan=""2"" align=""center"">Network Details</td></tr>" & vbCrLf
    CountAdaptor=0
    
        For Each objNetAdapConfigItem in colNetAdapConfigItems
            If isNull(objNetAdapConfigItem.IPAddress) Then
                '// Skip adapter, not currently used
            Else
                netmsg = netmsg & "<tr><td>Network Adapter:</td><td><input type=""text""  name=""Net_Adaptor"" readonly=""readonly"" value=""" & objNetAdapConfigItem.Description & """></td></tr>" & vbCrLf
                netmsg = netmsg & "<tr><td>MAC Address:</td><td><input type=""text""  name=""MAC"" readonly=""readonly"" value=""" & objNetAdapConfigItem.MACAddress & """></td></tr>" & vbCrLf
                'netmsg = netmsg & "     DHCP Enabled:          " & objNetAdapConfigItem.DHCPEnabled & vbCrLf
                netmsg = netmsg & "<tr><td>IP Address:</td><td><input type=""text""  name=""IP_Add"" readonly=""readonly"" value=""" & Join(objNetAdapConfigItem.IPAddress, ",") & """></td></tr>" & vbCrLf
                'netmsg = netmsg & "     Subnet Mask:           " & Join(objNetAdapConfigItem.IPSubnet, ",") & vbCrLf
                'netmsg = netmsg & "     Default Gateway:       " & Join(objNetAdapConfigItem.DefaultIPGateway, ",") & vbCrLf
                'If objNetAdapConfigItem.DHCPEnabled = True Then
    
                '    objSWbemDateTime.Value = objNetAdapConfigItem.DHCPLeaseObtained
                '    DHCPLeaseObtained = objSWbemDateTime.GetVarDate(True)
                '    netmsg = netmsg & "     Lease Obtained:        " & DHCPLeaseObtained  & vbCrLf
    
                '    objSWbemDateTime.Value = objNetAdapConfigItem.DHCPLeaseExpires
                '    DHCPLeaseExpires = objSWbemDateTime.GetVarDate(True)
                '    netmsg = netmsg & "     Lease Exipres:         " & DHCPLeaseExpires  & vbCrLf & vbCrLf
    
                '    netmsg = netmsg & "     DHCP Servers:          " & objNetAdapConfigItem.DHCPServer & vbCrLf
                'End If
                'netmsg = netmsg & "     DNS Server:            " & Join(objNetAdapConfigItem.DNSServerSearchOrder, ",") & vbCrLf
                'If Not objNetAdapConfigItem.WINSPrimaryServer = "" Then
                '    netmsg = netmsg & "     WINS Primary Server:   " & objNetAdapConfigItem.WINSPrimaryServer & vbCrLf
                '    If Not objNetAdapConfigItem.WINSSecondaryServer = "" Then
                '        netmsg = netmsg & "     WINS Secondary Server: " & objNetAdapConfigItem.WINSPrimaryServer & vbCrLf
                '    End If
                '    netmsg = netmsg & "     Enable LMHosts Lookup: " & objNetAdapConfigItem.WINSEnableLMHostsLookup & vbCrLf
                'End If
    
            End If
    
        Next
    
        ComputerDetail = "<tr><td>Computer Model:</td><td><input type=""text""  name=""CPU_Model"" readonly=""readonly"" value=""" & CompSysName & """></td></tr>" & vbCrLf & _
        "<tr><td>CPU Serial Number:</td><td><input type=""text""  name=""CPU_Serial"" readonly=""readonly"" value=""" & IdentifyingNumber & """></td></tr>" & vbCrLf
        '"     BIOS Version:          " & SMBIOSVersion & vbCrLf & _
        '"     UUID:                  " & UUID & vbCrLf
           'MsgBox ComputerDetail
    
    WScript.Sleep 3000
    
    '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '//
    '// This pause call is disabled, but you may wish to enable it if running this script
    '// with the ElevateThisScript() subroutine call enabled above:
    
    ' PressEnter()
    
    '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '//
    '// Functions: GetKeys() and decodeKey(iValues, strProduct)
    '//
    '// Credit where credit is due - I found and modified script posted by user "Parabellum"
    '// found on http://www.visualbasicscript.com/m42793.aspx, hacked it up a bit, and used
    '// it here to post keys:
    
    Public Function GetKeys()
        For x = LBound(arrSubKeys, 1) To UBound(arrSubKeys, 1)
        objReg.GetBinaryValue HKEY_LOCAL_MACHINE, arrSubKeys(x,1), SEARCH_KEY, arrDPIDBytes
    
            If Not IsNull(arrDPIDBytes) Then
                Call decodeKey(arrDPIDBytes, arrSubKeys(x,0))
    
            Else
                objReg.EnumKey HKEY_LOCAL_MACHINE, arrSubKeys(x,1), arrGUIDKeys
    
                If Not IsNull(arrGUIDKeys) Then
                    For Each GUIDKey In arrGUIDKeys
                        objReg.GetBinaryValue HKEY_LOCAL_MACHINE, arrSubKeys(x,1) & "\" & GUIDKey, SEARCH_KEY, arrDPIDBytes
                       '***********HACKED (don't remember why but it works)**********
                        If Not IsNull(arrDPIDBytes) Then
                            Call decodeKey1(arrDPIDBytes, arrSubKeys(x,0))
                        End If
                    Next
                End If
            End If
        Next
    
    End Function
    
        Public Function decodeKey(iValues, strProduct)
            Dim arrDPID
            arrDPID = Array()
    
                For i = 52 to 66
                    ReDim Preserve arrDPID( UBound(arrDPID) + 1 )
                    arrDPID( UBound(arrDPID) ) = iValues(i)
                Next
    
            Dim arrChars
            arrChars = Array("B","C","D","F","G","H","J","K","M","P","Q","R","T","V","W","X","Y","2","3","4","6","7","8","9")
    
                For i = 24 To 0 Step -1
                    k = 0
    
                    For j = 14 To 0 Step -1
                        k = k * 256 Xor arrDPID(j)
                        arrDPID(j) = Int(k / 24)
                        k = k Mod 24
                    Next
    
                    strProductKey = arrChars(k) & strProductKey
    
                    If i Mod 5 = 0 And i <> 0 Then
                        strProductKey = "-" & strProductKey
                    End If
                Next
    
            ReDim Preserve foundKeys( UBound(foundKeys) + 1 )
            foundKeys( UBound(foundKeys) ) = strProductKey
            strKey = UBound(foundKeys)
            'Wscript.Echo "   1  " & strProduct & "" & foundKeys(strKey)
           MSType1 = "<tr><td>OS License:</td><td><input type=""text""  name=""OS_License"" readonly=""readonly"" value=""" & foundKeys(strKey) & """></td></tr>"  &vbCrLf
           'Wscript.Echo MSType1
        End Function
    
    '******* HACKED (copy of decodekey function)***********
        Public Function decodeKey1(iValues, strProduct) '######################### this is for Office KEY search
            Dim arrDPID
            arrDPID = Array()
    
                For i = 52 to 66
                    ReDim Preserve arrDPID( UBound(arrDPID) + 1 )
                    arrDPID( UBound(arrDPID) ) = iValues(i)
                Next
    
            Dim arrChars
            arrChars = Array("B","C","D","F","G","H","J","K","M","P","Q","R","T","V","W","X","Y","2","3","4","6","7","8","9")
    
                For i = 24 To 0 Step -1
                    k = 0
    
                    For j = 14 To 0 Step -1
                        k = k * 256 Xor arrDPID(j)
                        arrDPID(j) = Int(k / 24)
                        k = k Mod 24
                    Next
    
                    strProductKey = arrChars(k) & strProductKey
    
                    If i Mod 5 = 0 And i <> 0 Then
                        strProductKey = "-" & strProductKey
                    End If
                Next
    
            ReDim Preserve foundKeys( UBound(foundKeys) + 1 )
            foundKeys( UBound(foundKeys) ) = strProductKey
            strKey = UBound(foundKeys)
            'Wscript.Echo "   2  " & strProduct & "" & foundKeys(strKey)
           MSType = "<tr><td>Office License:</td><td><input type=""text""  name=""MS_License"" readonly=""readonly"" value=""" & foundKeys(strKey) & """></td></tr>"  &vbCrLf
           'Wscript.Echo MSType
        End Function
    
    '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '//
    '// Subroutine: PressEnter()
    '//
    '// Adds a pause with a "Press the ENTER key to continue." message when called.
    '//
    '// Usage:  Call this Subroutine to get a pause that will clear when the user presses the
    '// ENTER key (and ONLY the ENTER key) on their keyboard:
    
    Sub PressEnter()
        Wscript.Echo ""
        strMessage = "Press the ENTER key to continue. "
        Wscript.StdOut.Write strMessage
    
        Do While Not WScript.StdIn.AtEndOfLine
            Input = WScript.StdIn.Read(1)
        Loop
    End Sub
    
    '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '//
    '// Subroutine: ElevateThisScript()
    '//
    '// Forces the currently running script to prompt for elevation if it detects that the
    '// current user credentials do not have administrative privileges.
    '//
    '// If run on Windows XP / Server 2003 this script will cause the RunAs dialog to appear
    '// if the user does not have administrative rights, giving the opportunity to run as an
    '// administrator.
    '//
    '// If run on Windows Vista / Server 2008 this script will cause a UAC dialog to appear
    '// if the user does not have administrative rights and UAC is enabled, giving the
    '// opportunity for the script to run properly for a LUA user.
    '//
    '// This Sub Attempts to call the script with its original arguments.  Arguments that
    '// contain a space will be wrapped in double quotes when the script calls itself again.
    '//
    '// Usage:  Add a call to this sub (ElevateThisScript) to the beginning of your script to
    '// ensure that the script gets an administrative token.
    
    Sub ElevateThisScript()
    
           Const HKEY_CLASSES_ROOT  = &H80000000
           Const HKEY_CURRENT_USER  = &H80000001
           Const HKEY_LOCAL_MACHINE = &H80000002
           Const HKEY_USERS         = &H80000003
           const KEY_QUERY_VALUE        = 1
           Const KEY_SET_VALUE          = 2
    
           Dim scriptEngine, engineFolder, argString, arg, Args, scriptCommand
           Dim objShellApp : Set objShellApp = CreateObject("Shell.Application")
    
           scriptEngine = Ucase(Mid(Wscript.FullName,InstrRev(Wscript.FullName,"\")+1))
           engineFolder = Left(Wscript.FullName,InstrRev(Wscript.FullName,"\"))
           argString = ""
    
           Set Args = Wscript.Arguments
    
           For each arg in Args                                   'loop though argument array as a collection to rebuild argument string
                  If instr(arg," ") > 0 Then arg = """" & arg & """"     'if the argument contains a space wrap it in double quotes
                  argString = argString & " " & Arg
           Next
    
           scriptCommand = engineFolder & scriptEngine
    
           Dim strComputer : strComputer = "."
    
           Dim objReg, bHasAccessRight
           Set objReg=GetObject("winmgmts:"_
                  & "{impersonationLevel=impersonate}!\\" &_
                  strComputer & "\root\default:StdRegProv")
    
           'Check for administrative registry access rights
           objReg.CheckAccess HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Control\CrashControl", _
                  KEY_SET_VALUE, bHasAccessRight
    
           If bHasAccessRight = True Then
    
                  HasRequiredRegAccess = True
                  Exit Sub
    
           Else
    
                  HasRequiredRegAccess = False
                  objShellApp.ShellExecute scriptCommand, " """ & Wscript.ScriptFullName & """" & argString, "", "runas"
                  WScript.Quit
           End If
    End Sub
    '*********** HACKED *************
    ProgressMsg "Gathering Display/Monitor Information ...", strWindowTitle
    
    Dim FSO, RegEx, WMI, WSH
    Dim B, bn, ch1, chs, Desc, EDID, i, mfdt, wd, x
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set WMI = GetObject("winmgmts:" & "\\.\root\cimv2")
    Set WSH = CreateObject("WScript.Shell")
    Monitr=""
    
    For Each i in WMI.ExecQuery("SELECT * FROM Win32_DesktopMonitor")
    EDID = False : Desc = ""  
    
    On Error Resume Next  
    
    EDID = WSH.RegRead("HKLM\System\CurrentControlSet\Enum\" &_
    i.PNPDeviceID & "\Device Parameters\EDID")
    Desc = WSH.RegRead("HKLM\System\CurrentControlSet\Enum\" &_
    i.PNPDeviceID & "\DeviceDesc")    
    
    On Error Goto 0
    If TypeName(EDID) = "Variant()" Then Exit For  
    
    Next
    If Not TypeName(EDID) = "Variant()" Then MsgBox "PnP Match not found!" _
    , , "Quitting..." : WScript.Quit
    B = ""
    wd = EDID(8) * 256 + EDID(9)
    mfdt = MonthName(Month(DateAdd("ww", EDID(16), "1/1/" & 1990 + EDID(17))))
    For i = 0 to UBound(EDID)
    B = B & Chr(EDID(i))
    Next  
    
    Do Until wd < 1
    bn = wd Mod 2 & bn
    wd = wd \ 2
    ch1 = 0  
    
    If Len(bn) = 5 Then
    Do While Len(bn)
    ch1 = ch1 + (Mid(bn, 1, 1) * (2 ^ (Len(bn) - 1)))
    bn = mid(bn, 2)
    Loop
    End If  
    
    If ch1 Then chs = Chr(ch1 + 64) & chs
    Loop
    Set RegEx = New RegExp
    For Each x in Split("ModelName:c,VendorName:e,SerialNumber:f", ",")
    RegEx.Pattern = "\x00{3}[\xf" & Split(x, ":")(1) & "]\x00(.*)\x0a"
    If RegEx.Test(B) Then Execute Split(x, ":")(0) &_
    " = RegEx.Execute(B)(0).SubMatches(0)"
    Next  
    
    Monitr= "<tr><td>Monitor Model:</td><td><input type=""text""  name=""Monitor_Model"" readonly=""readonly"" value=""" & ModelName & """></td</tr>" & vbCrLf & "<tr><td>Monitor Serial:</td><td><input type=""text""  name=""Monitor_Serial"" readonly=""readonly"" value=""" & SerialNumber & """></td></tr>" & vbCrLf & vbCrLf  
    
    '********* HAKCED**************
    ' PrinterWMI.vbs
    ' Sample WMI Printer VBScript to interrogate properties
    ' Author Guy Thomas http://computerperformance.co.uk/
    ' Version 2.3 - December 2010
    ' -----------------------------------------------'
    'Option Explicit
    Dim objWMIService, objItem, colItems, strComputer, intPrinters
    prt = "<select name=""Printer_List"" size=""4"" readonly=""readonly"" >" & vbCrLf 
    
    strComputer ="."
    intPrinters = 1
    PrinterList=""
    ' --------------------------------------------
    ' Pure WMI Section
    Set objWMIService = GetObject _
    ("winmgmts:\\" & strComputer & "\root\CIMV2")
    Set colItems = objWMIService.ExecQuery _
    ("SELECT * FROM Win32_Printer")
    
    Call Wait() ' Goto Sub Routine at the end
    
    ' On Error Resume Next
    For Each objItem In colItems
    prt = prt & "<option readonly=""readonly"" value=""" & objItem.name  & "/" & objItem.PortName & """>" & ObjItem.name & " Port: " & objItem.PortName & "</option>" & vbCrLf
    
    Next
    'MsgBox prt
    
    sub Wait()
    If strComputer = "." then
    strComputer = "Local Host"
    else strComputer = strComputer
    end if
    
    End Sub
    WScript.Sleep 3000
    
    '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '// function to identify type of MS Office 
    
    Function GetOfficeVersion(strComputer)
        Set objWMI = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
        Set colItems = objWMI.ExecQuery( _
            "SELECT Version FROM Win32_Product WHERE Name Like 'Microsoft Office%'")
    
        If colItems.Count = 0 Then
            GetOfficeVersion = "0"
            Exit Function
        End If
    
        For Each objItem In colItems
           'office= "Office :" & objItem.Version & vbCrLf
           GetOfficeVersion= objItem.Name & vbCrLf
            'GetOfficeVersion = Left(objItem.Version,InStr(1,objItem.Version,".")-1)
            Exit Function
        Next
    
        Set objWMI = Nothing
        Set colItems = Nothing
        Set objWMI = Nothing
    
    End Function
    
    '// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '************ OUTPUT to HTML-**************
    
    '//######## to display monitor
    '// "<tr><td>CPU Serial: </td><td><input type=""text"" name=""CPU_Serial""  readonly=""readonly"" value=""" & SerialNumber & """></td></tr>" & vbcrlf & _
    
    '//
    '// Start echoing output to the screen
    ProgressMsg "Audit Completed. Click Ok to start creating Audit Report ...", strWindowTitle
    
    myHtml=""
    myHtml="<HTML><Head><Title>PC Inventory</Title></Head>" & vbcrlf & _
    "<Body>" & vbcrlf & "<Table border=""0"" align=""center""><TR><td colspan=""2"" align=""center"">System Details</td></tr>" & vbcrlf & _
    "<Form name=""NewInventory"" action=""http://205.220.52.50/Inventory/pcaudit.php"&quot; method=""POST"">" &vbCrLf & _
    "<tr><td>Computer Name:</td><td><input type=""text"" name=""CompName""  readonly=""readonly"" value=""" & CSName & """></td></tr>" & vbcrlf & _
    "<tr><td>Description:</td><td><Input type=""text"" name=""Description""></td></tr>" & vbCrLf & _
    "<tr><td>User Name:</td><td><input type=""text"" name=""User"" ></td></tr>" & vbCrLf & _
    "<tr><td>Department:</td><td><input type=""text"" name=""Department""></td></tr>" & vbcrlf & _
    ComputerDetail & _
    "<tr><td>Operating System:</td><td><Input type=""text"" name=""OS""  readonly=""readonly"" value=""" & Caption & Arch & """></td></tr>" & vbcrlf & _
    MSType1 & vbCrLf & _
    "<tr><td>Processor Type:</td><td><input type=""text"" name=""Processor_type""  readonly=""readonly"" value=""" & CPUmsg & """ ></td></tr>" & vbcrlf & _
    "<tr><td>RAM:</td><td><input type=""text"" name=""RAM""  readonly=""readonly"" value=""" & RAMmsg & """></td></tr>" & vbCrLf & _
    logdisk & _
    netmsg & _
    "<tr><td colspan=""2"" align=""Center"">Software</td></tr>" & vbCrLf & _
    "<tr><td>Ms Office Type</td><td><input type=""text"" name=""MS_OfficeType""  readonly=""readonly"" value=""" & GetOfficeVersion(CSName) & """></td></tr>" & vbCrlf & _
    MSType & vbcrlf & _
    "<tr><td colspan=""2"" align=""center"">Monitor Details</td></tr>" & vbCrLf & Monitr & vbCrLf & _
    "<tr><td colspan=""2"" align=""center"">Printers Connected</td></tr>" & vbCrLf & _
    "<tr><td>" & prt & "</td></tr>" & vbCrLf & _
    "<tr><td style=""text-align:right;"" colspan=""2""><input type=""Submit"" name=""Update_Inventory"" readonly=""readonly"" value=""Update""><input type=""button"" readonly=""readonly"" value=""Close"" onClick=""window.close();""></td></tr>" & vbcrlf & _
    "<tr><td colspan=""2""><div style=""font-size:10px;font-weight:bold;color:#AFC7C7;"">designed by Ryan</div></td></tr>" & vbCrLf & _
    "</table>" & vbcrlf & _
    "</Body></html>"
    
    'Open up the path to save the information into a text file
    Dim Stuff, myFSO, WriteStuff, dateStamp
    dateStamp = Date()
    
    'Write information to Text File
    Stuff = myHtml
    strFolder = "C:\Pc Inventory"
    
    SET objFSO = CREATEOBJECT("Scripting.FileSystemObject")
    
    IF objFSO.FolderExists(strFolder) = FALSE THEN
           objFSO.CreateFolder strFolder
    END IF
    
    Set myFSO = CreateObject("Scripting.FileSystemObject")
    Set WriteStuff = myFSO.CreateTextFile("c:\pc inventory\ryan-inventory.html", 8, True)
    WriteStuff.WriteLine(Stuff)
    WriteStuff.Close
    
    SET WriteStuff = NOTHING
    SET myFSO = NOTHING
    
    msgbox "Audit Report completed. Click Ok to open Report"
    WScript.Sleep 3000
    
    Dim IE
    Set IE = CreateObject("InternetExplorer.Application")
    
    With IE
            .left=200
            .top=200
            .height=600
            .width=800
            .menubar=0
            .toolbar=1
            .statusBar=0
            .navigate "c:\pc inventory\ryan-inventory.html"
            .visible=1
    End With
    
    'wait a while until IE as finished to load
    Do while IE.busy
    loop
    
    Set IE = Nothing
    
    WScript.Quit(0)
    
  1. No trackbacks yet.

Bad Behavior has blocked 92 access attempts in the last 7 days.