Scripting

Home

Databases

Scripting

On Windows based computers there is a lot of information that can be retrieved about installed hardware using Windows Management Instrumentation (WMI). A script to do this is available for download here. It is called `Info.hta` and an example of the output is shown on the right (scaled). While most information is retrieved at load time, some information such as CPU load is monitored continuously. When downloading you may get a warning like below that this type of file can harm your computer. This HTA file extensively uses VBScript and WMI calls. HTA files (like any program you download from the Internet) can be used to make changes to your computer or report back information to a third-party or to spy on you, hence the warning. This HTA does not make any changes to your computer, does not spy or report, it only displays the information on the screen. As the HTA is in plain text (unlike most programs you download from the Internet) you can open it using a text editor such as Notepad to view the source and to confirm that it is safe. If you do get a download warning then select Keep. After you download info.hta just double-click on the file to run it on your own computer. You may get a warning that the publisher could not be verified. You can remove this warning by first right-clicking on the file, selecting properties and then clicking on the Unblock button or Unblock check-box then clicking on OK. If you don't want to download the HTA file you can view the source by clicking here then copy that and save it. It may not be the prettiest code, but it works. It is a handy tool that does not need any installation and can be run from a USB drive. It can be used as is or as a resource for VBScript examples. This collection of scripts works on Windows XP to Windows 11, with limited functionality on earlier versions of Windows. While this is my compilation, many of the functions have been gleaned from examples found on the Internet. Dates are in DD/MM/YYYY format but you can modify the code to suit. The current version of Info.hta is 3.28 dated 12-Apr-2022. If you have any suggestions or improvements or find any errors then contact me. <head> <title id="ptitle">System Information V3.28</title> <!-- Title: System Information Revision No.: 1.00 Written by: Peter Leonard opyright: This software is the property of Eniware Pty. Ltd. ABN 11 004 002 359. The software is licenced not sold and is subject to the licence agreement. Date commenced: 20/07/2013 Date completed: Checked by: Date checked: Approved by: Date approved: 1.10 Date: 12/05/2014 1.10 Amender: Peter Leonard 1.10 Checker: 1.10 Details: Added Gateway, Subnet and DNS 1.20 Date: 01/08/2014 1.20 Amender: Peter Leonard 1.20 Checker: 1.20 Details: Added Network adaptor and driver version 2.10 Date: 22/02/2015 2.10 Amender: Peter Leonard 2.10 Checker: 2.10 Details: Added printers version 2.20 Date: 08/08/2015 2.20 Amender: Peter Leonard 2.20 Checker: 2.20 Details: Added Last Windows Update for Windows 10 2.30 Date: 29/08/2015 2.30 Amender: Peter Leonard 2.30 Checker: 2.30 Details: Added Windows Install date for Windows 10 2.40 Date: 16/09/2015 2.40 Amender: Peter Leonard 2.40 Checker: 2.40 Details: Added Windows Product key 2.50 Date: 17/10/2015 2.50 Amender: Peter Leonard 2.50 Checker: 2.50 Details: Refresh current CPU speed, CPU load and available RAM every second 2.60 Date: 24/10/2015 2.60 Amender: Peter Leonard 2.60 Checker: 2.60 Details: Show all active network adaptors with associated IP, MAC, Subnet, Gateway and DNS 2.70 Date: 15/11/2015 2.70 Amender: Peter Leonard 2.70 Checker: 2.70 Details: Include O/S build number 2.80 Date: 14/02/2016 2.80 Amender: Peter Leonard 2.80 Checker: 2.80 Details: Include Minor build number for Windows 10 2.90 Date: 13/08/2016 2.90 Amender: Peter Leonard 2.90 Checker: 2.90 Details: When discovering Make, Model and Serial number, the IF check for 'To be filled by O.E.M.' is case-sensitive and not all manufacturers use the same case so the test is now case-insensitive. 3.01 Date: 30/12/2016 3.01 Amender: Peter Leonard 3.01 Checker: 3.01 Details: Added graphics driver version, driver version date and Defender last update date 3.03 Date: 18/03/2017 3.03 Amender: Peter Leonard 3.03 Checker: 3.03 Details: Cater for graphics cards with more than 2GB of memory 3.04 Date: 21/06/2017 3.04 Amender: Peter Leonard 3.04 Checker: 3.04 Details: Show Windows uptime 3.05 Date: 03/12/2017 3.05 Amender: Peter Leonard 3.05 Checker: 3.05 Details: Added Microsoft Office Product Keys 3.06 Date: 26/03/2018 3.06 Amender: Peter Leonard 3.06 Checker: 3.06 Details: Fixed video RAM reporting error with two video cards 3.07 Date: 27/03/2018 3.07 Amender: Peter Leonard 3.07 Checker: 3.07 Details: Fixed order of reporting video driver version with two video cards 3.08 Date: 28/03/2018 3.08 Amender: Peter Leonard 3.08 Checker: 3.08 Details: Fixed function using GetDWORDValue 3.09 Date: 02/04/2018 3.09 Amender: Peter Leonard 3.09 Checker: 3.09 Details: Commented out Windows Up Time as it could leave to misleading values when the computer slept rather than restarted and anomalies with daylight savings changes 3.10 Date: 09/05/2018 3.10 Amender: Peter Leonard 3.10 Checker: 3.10 Details: Added Current user and domain 3.11 Date: 09/09/2018 3.11 Amender: Peter Leonard 3.11 Details: Re-enabled Windows Up Time 3.12 Date: 30/10/2018 3.12 Amender: Peter Leonard 3.12 Details: Increased the number of drives to look for from 8 to 10 3.13 Date: 10/02/2019 3.13 Amender: Peter Leonard 3.13 Details: Added "OneNote" to the list of non-printers 3.15 Date: 30/01/2020 3.15 Amender: Peter Leonard 3.15 Details: Cater for up to 3 display adaptors 3.16 Date: 15/05/2020 3.16 Amender: Peter Leonard 3.16 Details: Added "OneNote" port to the list of non-printers 3.17 Date: 27/01/2021 3.17 Amender: Peter Leonard 3.17 Details: Show only display adaptors with RAM (NOT NULL) or have VMware in the name so as to exclude phantom uninstalled secondary adaptors and remote display adaptors 3.18 Date: 21/03/2021 3.18 Amender: Peter Leonard 3.18 Details: Added help button 3.19 Date: 24/10/2021 3.19 Amender: Peter Leonard 3.19 Details: Removed current and maximun CPU speed since it is no longer reporting correct values with Windows 11 3.20 Date: 26/10/2021 3.20 Amender: Peter Leonard 3.20 Details: Removed graphics driver version and changed default width and height to 735 x 720. Removed 'Cisco AnyConnect', 'VMware Virtual Ethernet Adapter' and 'VirtualBox' from the discovered of network adapters 3.21 Date: 27/10/2021 3.21 Amender: Peter Leonard 3.21 Details: Revised graphics card extraction due to showing old card when a card is replaced. Revised make model and serial number extraction when the values are like SYSTEM 3.22 Date: 28/10/2021 3.22 Amender: Peter Leonard 3.22 Details: Revised make model and serial number extraction when the values are like EMPTY 3.23 Date: 29/10/2021 3.23 Amender: Peter Leonard 3.23 Details: Corrected thread and CPU count on multi-socket systems. 3.24 Date: 08/11/2021 3.24 Amender: Peter Leonard 3.24 Details: Combined disk size and model on the same line. 3.25 Date: 28/12/2021 3.25 Amender: Peter Leonard 3.25 Details: Fixed horizontal scroll bar that appeared when scaling the screen as is common on notebooks 3.26 Date: 15/01/2022 3.26 Amender: Peter Leonard 3.26 Details: Scale the application when the screen is other than 96DPI as is common on notebooks or 4K screens 3.27 Date: 26/01/2022 3.27 Amender: Peter Leonard 3.27 Details: Fix minor WMI call error with the getIPAddress function 3.28 Date: 12/04/2022 3.28 Amender: Peter Leonard 3.28 Details: Add CPU speed for 12th GEN Intel CPUs --> <script language="VBScript" type="text/vbscript"> Dim objOSType, OSVersion Const DESIGN_DPI = 96 Const DESIGN_WIDTH = 735 Const DESIGN_HEIGHT = 700 Const DESIGN_FONT_SIZE = 14 Window.ResizeTo DESIGN_WIDTH, DESIGN_HEIGHT xx = 0 yy = 0 dx = 1 dy = 1 hh = DESIGN_HEIGHT ww = DESIGN_WIDTH interval = 20 intHorizontal = 800 intVertical = 600 Video0 = "" Video1 = "" Video2 = "" card0 = "" card1 = "" card2 = "" VCCount = 0 Set objNetwork = CreateObject("WScript.Network") strComputer = "." Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") Set objShell = CreateObject("WScript.Shell") Const HKEY_CLASSES_ROOT = &H80000000 Const HKEY_CURRENT_USER = &H80000001 Const HKEY_CURRENT_CONFIG = &H80000005 Const HKEY_LOCAL_MACHINE = &H80000002 Const HKEY_USERS = &H80000003 Sub Resize_Window strComputer = "." Set colitems = objWMIService.ExecQuery("SELECT PixelsPerXLogicalInch, PixelsPerYLogicalInch FROM Win32_DesktopMonitor",,48) For Each objItem in colitems pixels_per_logical_inch_height = objItem.PixelsPerYLogicalInch pixels_per_logical_inch_width = objItem.PixelsPerXLogicalInch Next width_pixels = DESIGN_WIDTH height_pixels = DESIGN_HEIGHT font_size = DESIGN_FONT_SIZE If Not IsNull(pixels_per_logical_inch_height) And Not IsNull(pixels_per_logical_inch_width) Then width_pixels = Round(DESIGN_WIDTH / DESIGN_DPI * pixels_per_logical_inch_width) height_pixels = Round(DESIGN_HEIGHT / DESIGN_DPI * pixels_per_logical_inch_height) font_size = Round(DESIGN_FONT_SIZE / DESIGN_DPI * pixels_per_logical_inch_width) End If intHorizontal = screen.availWidth intVertical = screen.availHeight intLeft = Round((intHorizontal - width_pixels) / 2) intTop = Round((intVertical - height_pixels) / 2) Window.ResizeTo width_pixels, height_pixels If IsEmpty(intLeft) Or IsNull(intLeft) Then intLeft = 0 ElseIf IsNumeric(intLeft) Then If intLeft <= 0 Then intLeft = 0 End If End If If IsEmpty(intTop) Or IsNull(intTop) Then intTop = 0 ElseIf IsNumeric(intTop) Then If intTop <= 0 Then intTop = 0 End If End If xx = intLeft yy = intTop Window.MoveTo intLeft, intTop Set NodeList = document.getElementById("TheTable").getElementsByTagName("TD") For Each Elem In NodeList Elem.Style.fontSize = font_size & "px" Next End Sub Function NVL(inval,nulval) If IsNull(inval) Then NVL = nulval Else NVL = inval End If End Function Function getSerialNumber() On Error Resume Next getSerialNumber = "" Set colBIOS = objWMIService.ExecQuery("Select SerialNumber from Win32_BIOS") For each objBIOS in colBIOS If objBIOS.SerialNumber <> "" Then getSerialNumber = objBIOS.SerialNumber Exit For End If Next If LCase(getSerialNumber) = "to be filled by o.e.m." Or LCase(getSerialNumber) = "default string" Or Trim(getSerialNumber) = "" Or InStr(LCase(getSerialNumber), "system") > 0 Or InStr(LCase(getSerialNumber), "empty") > 0 Or Trim(getSerialNumber) = "n" Or Trim(getSerialNumber) = "0" Or Trim(getSerialNumber) = "12345678901234567" Or Trim(getSerialNumber) = "INVALID" Then Set colItems = objWMIService.ExecQuery("Select IdentifyingNumber, UUID from Win32_ComputerSystemProduct") For Each objItem in colItems If objItem.IdentifyingNumber <> "" Then getSerialNumber = objItem.IdentifyingNumber Exit For End If Next If LCase(getSerialNumber) = "to be filled by o.e.m." Or LCase(getSerialNumber) = "default string" Or Trim(getSerialNumber) = "" Or InStr(LCase(getSerialNumber), "system") > 0 Or InStr(LCase(getSerialNumber), "empty") > 0 Or Trim(getSerialNumber) = "n" Or Trim(getSerialNumber) = "0" Or Trim(getSerialNumber) = "12345678901234567" Or Trim(getSerialNumber) = "INVALID" Then For Each objItem in colItems If objItem.UUID <> "" Then getSerialNumber = objItem.UUID Exit For End If Next End If End If If LCase(getSerialNumber) = "to be filled by o.e.m." Or LCase(getSerialNumber) = "default string" Or InStr(LCase(getSerialNumber), "system") > 0 Or InStr(LCase(getSerialNumber), "empty") > 0 Or Trim(getSerialNumber) = "n" Or Trim(getSerialNumber) = "0" Or Trim(getSerialNumber) = "12345678901234567" Or Trim(getSerialNumber) = "INVALID" Then getSerialNumber = "" End If End Function Function getBIOSdate() On Error Resume Next getBIOSdate = "" Set colBIOS = objWMIService.ExecQuery("Select ReleaseDate from Win32_BIOS",,48) For each objBIOS in colBIOS If objBIOS.ReleaseDate <> "" Then getBIOSdate = Left(objBIOS.ReleaseDate, 8) Exit For End If Next End Function Function getBIOSversion() On Error Resume Next getBIOSversion = "" Set colBIOS = objWMIService.ExecQuery("Select Version, SMBIOSBIOSVersion from Win32_BIOS",,48) For each objBIOS in colBIOS If objBIOS.Version <> "" Then getBIOSversion = objBIOS.SMBIOSBIOSVersion Exit For End If Next End Function Function getMacAddress() On Error Resume Next getMacAddress = "" mcount = 0 'Set colItems = objWMIService.ExecQuery("SELECT MACAddress FROM Win32_NetworkAdapter WHERE NetConnectionStatus = 2 AND NOT Manufacturer = 'Microsoft' AND NOT Manufacturer = 'Oracle Corporation' AND AdapterType LIKE 'Ethernet%' AND AdapterTypeId = 0 AND NOT ProductName LIKE '%mini%po%rt%' AND NOT MACAddress = '' AND MACAddress IS NOT NULL",,48) Set colItems = objWMIService.ExecQuery("SELECT MACAddress FROM Win32_NetworkAdapter WHERE NetConnectionStatus = 2 AND NOT MACAddress = '' AND MACAddress IS NOT NULL AND NOT Description LIKE 'VMware Virtual Ethernet Adapter%' AND NOT Description LIKE '%Cisco AnyConnect%' AND NOT Description LIKE '%VirtualBox%'",,48) For Each objItem in colItems If Not IsNull(objItem.MACAddress) Then If mcount = 0 Then getMacAddress = objItem.MACAddress Else getMacAddress = getMacAddress & ", " & objItem.MACAddress End If mcount = mcount + 1 End If Next End Function Function getIPAddress(MAC) On Error Resume Next getIPAddress = "" ipcount = 0 Set colNicConfig = objWMIService.ExecQuery("SELECT IPAddress FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True AND NOT Description LIKE 'VMware Virtual Ethernet Adapter%' AND NOT Description LIKE '%Cisco AnyConnect%' AND NOT Description LIKE '%VirtualBox%' AND MACAddress = '" & MAC & "'",,48) For Each objNicConfig In colNicConfig If Not IsNull(objNicConfig.IPAddress) Then For Each strIPAddress In objNicConfig.IPAddress If Len(strIPAddress) < 16 and Len(strIPAddress) > 6 Then If ipcount = 0 Then getIPAddress = strIPAddress Else getIPAddress = getIPAddress & ", " & strIPAddress End If ipcount = ipcount + 1 End If Next End If If getIPAddress <> "" Then Exit for End If Next End Function Function getIPAddresses() On Error Resume Next getIPAddresses = "" ipcount = 0 Set colNicConfig = objWMIService.ExecQuery("SELECT IPAddress FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True AND NOT Description LIKE 'VMware Virtual Ethernet Adapter%' AND NOT Description LIKE '%Cisco AnyConnect%' AND NOT Description LIKE '%VirtualBox%'",,48) For Each objNicConfig In colNicConfig If Not IsNull(objNicConfig.IPAddress) Then For Each strIPAddress In objNicConfig.IPAddress If Len(strIPAddress) < 16 and Len(strIPAddress) > 6 Then If InStr(getIPAddresses, strIPAddress) = 0 Then If ipcount = 0 Then getIPAddresses = strIPAddress Else getIPAddresses = getIPAddresses & ", " & strIPAddress End If ipcount = ipcount + 1 End If End If Next End If Next End Function Function getNIC() On Error Resume Next getNIC = "" ncount = 0 'Set colNicConfig = objWMIService.ExecQuery("SELECT Name FROM Win32_NetworkAdapter WHERE NetConnectionStatus = 2 AND NOT Manufacturer = 'Microsoft' AND NOT Manufacturer = 'Oracle Corporation' AND AdapterType LIKE 'Ethernet%' AND AdapterTypeId = 0 AND NOT ProductName LIKE '%mini%po%rt%' AND NOT MACAddress = '' AND MACAddress IS NOT NULL",,48) Set colNicConfig = objWMIService.ExecQuery("SELECT Name FROM Win32_NetworkAdapter WHERE NetConnectionStatus = 2 AND NOT MACAddress = '' AND MACAddress IS NOT NULL AND NOT Description LIKE 'VMware Virtual Ethernet Adapter%' AND NOT Description LIKE '%Cisco AnyConnect%' AND NOT Description LIKE '%VirtualBox%'",,48) For Each objNicConfig In colNicConfig If Not IsNull(objNicConfig.Name) Then If objNicConfig.Name <> "" Then If ncount = 0 Then getNIC = objNicConfig.Name Else getNIC = getNIC & "<br>" & objNicConfig.Name End If ncount = ncount + 1 End If End If Next End Function Function getNicDriverVer() On Error Resume Next getNicDriverVer = "" Set colNic = objWMIService.ExecQuery("SELECT DriverVersion from Win32_PnPSignedDriver WHERE deviceclass = 'net' AND Devicename = '" & getNIC() & "'") For Each objNic In colNic If Not IsNull(objNic.DriverVersion) Then getNicDriverVer = objNic.DriverVersion End If If getNicDriverVer <> "" Then Exit for End If Next End Function Function getSubnet() On Error Resume Next Subnet = "" scount = 0 Set colNicConfig = objWMIService.ExecQuery("SELECT IPSubnet FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True AND NOT Description LIKE 'VMware Virtual Ethernet Adapter%' AND NOT Description LIKE '%Cisco AnyConnect%' AND NOT Description LIKE '%VirtualBox%'",,48) For Each objNicConfig In colNicConfig If Not IsNull(objNicConfig.IPSubnet) Then For i = LBound(objNicConfig.IPSubnet) to UBound(objNicConfig.IPSubnet) If Not (objNicConfig.IPSubnet(i) = "64") Then If InStr(Subnet, objNicConfig.IPSubnet(i)) = 0 Then If scount = 0 Then Subnet = objNicConfig.IPSubnet(i) Else Subnet = Subnet & ", " & objNicConfig.IPSubnet(i) End If scount = scount + 1 End If End If Next End If Next getSubnet = Subnet End Function Function getGateway() On Error Resume Next Gateway = "" gcount = 0 Set colNicConfig = objWMIService.ExecQuery("SELECT DefaultIPGateway FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True AND NOT Description LIKE 'VMware Virtual Ethernet Adapter%' AND NOT Description LIKE '%Cisco AnyConnect%' AND NOT Description LIKE '%VirtualBox%'",,48) For Each objNicConfig In colNicConfig If Not IsNull(objNicConfig.DefaultIPGateway) Then For i = LBound(objNicConfig.DefaultIPGateway) to UBound(objNicConfig.DefaultIPGateway) If Not (objNicConfig.DefaultIPGateway(i) = "0.0.0.0") Then If InStr(Gateway, objNicConfig.DefaultIPGateway(i)) = 0 Then If gcount = 0 Then Gateway = objNicConfig.DefaultIPGateway(i) Else Gateway = Gateway & ", " & objNicConfig.DefaultIPGateway(i) End If gcount = gcount + 1 End If End If Next End If Next getGateway = Gateway End Function Function getDNS() On Error Resume Next getDNS = "" dcount = 0 Set colNicConfig = objWMIService.ExecQuery("SELECT DNSServerSearchOrder FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True AND NOT Description LIKE 'VMware Virtual Ethernet Adapter%' AND NOT Description LIKE '%Cisco AnyConnect%' AND NOT Description LIKE '%VirtualBox%'",,48) For Each objNicConfig In colNicConfig If Not IsNull(objNicConfig.DNSServerSearchOrder) Then For i = LBound(objNicConfig.DNSServerSearchOrder) to UBound(objNicConfig.DNSServerSearchOrder) If Not (objNicConfig.DNSServerSearchOrder(i) = "0.0.0.0") Then If InStr(getDNS, objNicConfig.DNSServerSearchOrder(i)) = 0 Then If dcount = 0 Then getDNS = objNicConfig.DNSServerSearchOrder(i) Else getDNS = getDNS & ", " & objNicConfig.DNSServerSearchOrder(i) End If dcount = dcount + 1 End If End If Next End If Next End Function Function getMake() On Error Resume Next getMake = "" Set colSettings = objWMIService.ExecQuery("Select Manufacturer from Win32_ComputerSystem",,48) For Each objComputer in colSettings getMake = objComputer.Manufacturer Exit For Next If LCase(getMake) = "to be filled by o.e.m." Or LCase(getMake) = "default string" Or InStr(LCase(getMake), "system") > 0 Or InStr(LCase(getMake), "empty") > 0 Then Set colSettings = objWMIService.ExecQuery("select Manufacturer from Win32_BaseBoard",,48) For Each objInstance In colSettings getMake = objInstance.Manufacturer Exit For Next End If If LCase(getMake) = "to be filled by o.e.m." Or LCase(getMake) = "default string" Or InStr(LCase(getMake), "system") > 0 Or InStr(LCase(getMake), "empty") > 0 Then getMake = "" End If End Function Function getModel() On Error Resume Next getModel = "" Set colSettings = objWMIService.ExecQuery("Select Model from Win32_ComputerSystem",,48) For Each objComputer in colSettings getModel = objComputer.Model Exit For Next If LCase(getModel) = "to be filled by o.e.m." Or LCase(getModel) = "default string" Or InStr(LCase(getModel), "system") > 0 Or InStr(LCase(getModel), "empty") > 0 Then Set colSettings = objWMIService.ExecQuery("select Product from Win32_BaseBoard",,48) For Each objInstance In colSettings getModel = objInstance.Product Exit For Next End If If LCase(getModel) = "to be filled by o.e.m." Or LCase(getModel) = "default string" Or InStr(LCase(getModel), "system") > 0 Or InStr(LCase(getModel), "empty") > 0 Then getModel = "" End If End Function Function getRam() On Error Resume Next getRam = 0 Set colSettings = objWMIService.ExecQuery("Select TotalPhysicalMemory from Win32_ComputerSystem",,48) For Each objComputer In colSettings getRam = objComputer.TotalPhysicalMemory Exit For Next End Function Function getInstalledRam() On Error Resume Next getInstalledRam = 0 Set colItems = objWMIService.ExecQuery("Select Capacity from Win32_PhysicalMemory",,48) For Each objItem In colItems getInstalledRam = getInstalledRam + objItem.Capacity Next End Function Function getAvailableRam() On Error Resume Next getAvailableRam = 0 Set perfData = objWMIService.ExecQuery ("Select AvailableMBytes from Win32_PerfFormattedData_PerfOS_Memory ",,48) For Each objPerfdata In perfData getAvailableRam = objPerfdata.AvailableMBytes Exit For Next End Function Function getRamType() On Error Resume Next Dim RamType, RamSpeed getRamType = "" Set colItems = objWMIService.ExecQuery ("Select MemoryType, Speed from Win32_PhysicalMemory",,48) For Each objItem in colItems RamType = objItem.MemoryType RamSpeed = objItem.Speed Exit For Next If RamType = 0 Then If RamSpeed >= 4750 Then getRamType = "DDR5 @ " & RamSpeed & "MHz" ElseIf RamSpeed > 1800 Then getRamType = "DDR4 @ " & RamSpeed & "MHz" ElseIf RamSpeed > 800 Then getRamType = "DDR3 @ " & RamSpeed & "MHz" ElseIf RamSpeed > 400 Then getRamType = "DDR2 @ " & RamSpeed & "MHz" Elseif RamSpeed > 0 Then getRamType = "DDR1 @ " & RamSpeed & "MHz" Else getRamType = "" End If ElseIf RamType = 24 Then getRamType = "DDR3 @ " & RamSpeed & "MHz" ElseIf RamType < 24 And RamType > 20 Then getRamType = "DDR2 @ " & RamSpeed & "MHz" ElseIf RamType = 20 Then getRamType = "DDR1 @ " & RamSpeed & "MHz" ElseIf RamType = 19 Then getRamType = "RDRAM @ " & RamSpeed & "MHz" ElseIf RamType = 18 Then getRamType = "SGRAM @ " & RamSpeed & "MHz" ElseIf RamType = 17 Then getRamType = "SDRAM @ " & RamSpeed & "MHz" Else getRamType = "" End If End Function Function getCPUCount() On Error Resume Next getCPUCount = 0 Set colCompSys = objWMIService.ExecQuery("Select NumberOfProcessors from Win32_ComputerSystem",,48) For Each objCS in colCompSys getCPUCount = objCS.NumberOfProcessors Exit For Next End Function Function getCores() On Error Resume Next getCores = 0 Set colProcessors = objWMIService.ExecQuery("Select NumberOfCores from Win32_Processor",,48) For Each objProcessor in colProcessors getCores = getCores + objProcessor.NumberOfCores Next End Function Function getArch() On Error Resume Next getArch = "" Set colProcessors = objWMIService.ExecQuery("Select Architecture from Win32_Processor",,48) For Each objProcessor in colProcessors getArch = objProcessor.Architecture Exit For Next If getArch = 0 Then getArch = "x86" ElseIf getArch = 1 Then getArch = "MIPS" ElseIf getArch = 2 Then getArch = "Alpha" ElseIf getArch = 3 Then getArch = "PowerPC" ElseIf getArch = 6 Then getArch = "Itanium" ElseIf getArch = 9 Then getArch = "x64" End If End Function Function getCPU() On Error Resume Next getCPU = "" Set colItems = objWMIService.ExecQuery("Select Name from Win32_Processor",,48) For Each objItem in colItems getCPU = objItem.Name Exit For Next If getCPU = "Intel(R) Pentium(R) III Xeon processor" Or getCPU = "Intel Pentium III Xeon processor" Or getCPU = "Intel Pentium II processor" Or getCPU = "Intel Pentium III processor" Then regCPU = objShell.RegRead("HKEY_LOCAL_MACHINE\HARDWARE\DESCRIPTION\System\CentralProcessor\0\ProcessorNameString") If regCPU <> "" Then getCPU = regCPU End If End If End Function Function getLogicalCPUs() On Error Resume Next getLogicalCPUs = 0 Set colProcessors = objWMIService.ExecQuery("Select NumberOfLogicalProcessors from Win32_Processor",,48) For Each objProcessor in colProcessors getLogicalCPUs = getLogicalCPUs + objProcessor.NumberOfLogicalProcessors Next End Function Function getCPUspeed() On Error Resume Next getCPUspeed = 0 Set colItems = objWMIService.ExecQuery("Select MaxClockSpeed from Win32_Processor",,48) For Each objItem in colItems getCPUspeed = objItem.MaxClockSpeed Exit For Next End Function Function getCPUcurrentSpeed() On Error Resume Next getCPUcurrentSpeed = 0 Set colItems = objWMIService.ExecQuery("Select CurrentClockSpeed from Win32_Processor",,48) For Each objItem in colItems getCPUcurrentSpeed = objItem.CurrentClockSpeed Exit For Next End Function Function getOSName() On Error Resume Next getOSName = "" Set colSettings = objWMIService.ExecQuery("Select Caption from Win32_OperatingSystem",,48) For Each objOperatingSystem in colSettings getOSName = objOperatingSystem.Caption Exit For Next End Function Function getOSBuild() On Error Resume Next getOSBuild = "" Set colSettings = objWMIService.ExecQuery("Select Version from Win32_OperatingSystem",,48) For Each objOperatingSystem in colSettings getOSBuild = objOperatingSystem.Version Exit For Next UBR = RegGetDWORDValue("SOFTWARE\Microsoft\Windows NT\CurrentVersion","UBR") BuildName = RegGetStringValue("SOFTWARE\Microsoft\Windows NT\CurrentVersion","DisplayVersion") If Not IsNull(UBR) Then getOSBuild = getOSBuild & "." & UBR End If If Not IsNull(BuildName) Then getOSBuild = getOSBuild & " - " & BuildName End If End Function Function RegGetStringValue(sSubKeyName,sValueName) On Error Resume Next RegGetStringValue = "" If objOSType = "x86" Then Set objReg = GetWMIRegProvider() objReg.GetStringValue HKEY_LOCAL_MACHINE,sSubKeyName,sValueName,sValue RegGetStringValue = sValue Else Set objCtx = CreateObject("WbemScripting.SWbemNamedValueSet") objCtx.Add "__ProviderArchitecture", 64 Set objLocator = CreateObject("Wbemscripting.SWbemLocator") Set objServices = objLocator.ConnectServer("","root\default","","",,,,objCtx) Set objStdRegProv = objServices.Get("StdRegProv") Set Inparams = objStdRegProv.Methods_("GetStringValue").Inparameters Inparams.Hdefkey = HKEY_LOCAL_MACHINE Inparams.Ssubkeyname = sSubKeyName Inparams.Svaluename = sValueName Set Outparams = objStdRegProv.ExecMethod_("GetStringValue", Inparams,,objCtx) RegGetStringValue = Outparams.sValue End If End Function Function RegGetDWORDValue(sSubKeyName,sValueName) On Error Resume Next RegGetDWORDValue = "" If objOSType = "x86" Then Set objReg = GetWMIRegProvider() objReg.GetDWORDValue HKEY_LOCAL_MACHINE,sSubKeyName,sValueName,dwValue RegGetDWORDValue = dwValue Else Set objCtx = CreateObject("WbemScripting.SWbemNamedValueSet") objCtx.Add "__ProviderArchitecture", 64 Set objLocator = CreateObject("Wbemscripting.SWbemLocator") Set objServices = objLocator.ConnectServer("","root\default","","",,,,objCtx) Set objStdRegProv = objServices.Get("StdRegProv") Set Inparams = objStdRegProv.Methods_("GetDWORDValue").Inparameters Inparams.Hdefkey = HKEY_LOCAL_MACHINE Inparams.sSubKeyName = sSubKeyName Inparams.sValueName = sValueName Set Outparams = objStdRegProv.ExecMethod_("GetDWORDValue", Inparams,,objCtx) RegGetDWORDValue = Outparams.uValue End If End Function Function RegGetQWORDValue(sSubKeyName,sValueName) On Error Resume Next RegGetQWORDValue = "" If objOSType = "x86" Then Set objReg = GetWMIRegProvider() objReg.GetQWORDValue HKEY_LOCAL_MACHINE,sSubKeyName,sValueName,uValue RegGetQWORDValue = uValue Else Set objCtx = CreateObject("WbemScripting.SWbemNamedValueSet") objCtx.Add "__ProviderArchitecture", 64 Set objLocator = CreateObject("Wbemscripting.SWbemLocator") Set objServices = objLocator.ConnectServer("","root\default","","",,,,objCtx) Set objStdRegProv = objServices.Get("StdRegProv") Set Inparams = objStdRegProv.Methods_("GetQWORDValue").Inparameters Inparams.Hdefkey = HKEY_LOCAL_MACHINE Inparams.sSubKeyName = sSubKeyName Inparams.sValueName = sValueName Set Outparams = objStdRegProv.ExecMethod_("GetQWORDValue", Inparams,,objCtx) RegGetQWORDValue = Outparams.uValue End If End Function Function getOSversion() On Error Resume Next getOSversion = "" Set colSettings = objWMIService.ExecQuery("Select Version from Win32_OperatingSystem",,48) For Each objOperatingSystem in colSettings getOSversion = objOperatingSystem.Version Exit For Next VerMajMin = Split(getOSversion, ".") If Ubound(VerMajMin) > 0 Then getOSversion = (CDbl(VerMajMin(0)) * 10 + CDbl(VerMajMin(1))) / 10 End If End Function Function getOSSP() On Error Resume Next getOSSP = "" Set colSettings = objWMIService.ExecQuery("Select ServicePackMajorVersion, ServicePackMinorVersion from Win32_OperatingSystem",,48) For Each objOperatingSystem in colSettings getOSSP = objOperatingSystem.ServicePackMajorVersion & "." & objOperatingSystem.ServicePackMinorVersion Exit For Next End Function Function Ceil(Number) Ceil = Int(Number) If Ceil <> Number Then Ceil = Ceil + 1 End If End Function Function getDiskSize(DL) On Error Resume Next getDiskSize = 0 Set colDisks = objWMIService.ExecQuery("Select Size from Win32_LogicalDisk WHERE DeviceID = '" & DL & "' AND (DriveType = 2 Or DriveType = 3)",,48) For Each objDisk in colDisks getDiskSize = objDisk.Size Exit For Next End Function Function getDiskFree(DL) On Error Resume Next getDiskFree = 0 Set colDisks = objWMIService.ExecQuery("Select FreeSpace from Win32_LogicalDisk WHERE DeviceID = '" & DL & "' AND (DriveType = 2 Or DriveType = 3)",,48) For Each objDisk in colDisks getDiskFree = objDisk.FreeSpace Exit For Next End Function Function getDiskModel(id) On Error Resume Next getDiskModel = "" Set colItems = objWMIService.ExecQuery( "SELECT Model FROM Win32_DiskDrive WHERE DeviceID = '\\\\.\\PHYSICALDRIVE" & id & "'",,48) For Each objItem in colItems getDiskModel = objItem.Model Exit For Next End Function Function getDiskModelFromDriveLetter(DriveLetter) On Error Resume Next getDiskModelFromDriveLetter = "" DiskDeviceID = "" Dim DiskDeviceID, diskDrives, partitions, diskDrive, logicalDisk, logicalDisks Set diskDrives = objWMIService.ExecQuery("SELECT DeviceID FROM Win32_DiskDrive",,48) For Each diskDrive In diskDrives Set partitions = objWMIService.ExecQuery("ASSOCIATORS OF {Win32_DiskDrive.DeviceID='" + diskDrive.DeviceID + "'} WHERE AssocClass = Win32_DiskDriveToDiskPartition",,48) For Each partition In partitions Set logicalDisks = objWMIService.ExecQuery("ASSOCIATORS OF {Win32_DiskPartition.DeviceID='" + partition.DeviceID + "'} WHERE AssocClass = Win32_LogicalDiskToPartition",,48) For Each logicalDisk In logicalDisks If logicalDisk.DeviceID = DriveLetter Then DiskDeviceID = diskDrive.DeviceID Exit For End If Next Next Next DiskDeviceID = Replace(DiskDeviceID,"\","\\") Set colItems = objWMIService.ExecQuery("SELECT Model, Index FROM Win32_DiskDrive WHERE DeviceID = '" & DiskDeviceID & "'",,48) For Each objItem in colItems getDiskModelFromDriveLetter = objItem.Model & " (" & objItem.Index & ")" Next End Function Function getScreenWidth() On Error Resume Next getScreenWidth = 0 If OSVersion >= 6.1 Then Set colItems = objWMIService.ExecQuery("Select CurrentHorizontalResolution FROM Win32_VideoController WHERE DeviceID = 'VideoController1' AND (AdapterRAM IS NOT NULL OR Name LIKE '%VMware%')",,0) For Each objItem in colItems getScreenWidth = objItem.CurrentHorizontalResolution Exit For Next Else Set colItems = objWMIService.ExecQuery("Select ScreenWidth From Win32_DesktopMonitor where DeviceID = 'DesktopMonitor1'",,48) For Each objItem in colItems getScreenWidth = objItem.ScreenWidth Exit For Next End If End Function Function getScreenHeight() On Error Resume Next getScreenHeight = 0 If OSVersion >= 6.1 Then Set colItems = objWMIService.ExecQuery("SELECT CurrentVerticalResolution FROM Win32_VideoController WHERE DeviceID = 'VideoController1' AND (AdapterRAM IS NOT NULL OR Name LIKE '%VMware%')",,48) For Each objItem in colItems getScreenHeight = objItem.CurrentVerticalResolution Next Else Set colItems = objWMIService.ExecQuery("Select ScreenHeight From Win32_DesktopMonitor where DeviceID = 'DesktopMonitor1'",,48) For Each objItem in colItems getScreenHeight = objItem.ScreenHeight Next End If End Function Function getScreenResolution() On Error Resume Next getScreenResolution = "" If OSVersion >= 6.1 Then Set colItems = objWMIService.ExecQuery("SELECT CurrentVerticalResolution, CurrentHorizontalResolution FROM Win32_VideoController WHERE (AdapterRAM IS NOT NULL OR Name LIKE '%VMware%')",,48) For Each objItem in colItems If objItem.CurrentHorizontalResolution > 0 And objItem.CurrentHorizontalResolution <> "" Then If getScreenResolution = "" Then getScreenResolution = objItem.CurrentHorizontalResolution & "x" & objItem.CurrentVerticalResolution Else getScreenResolution = getScreenResolution & ", " & objItem.CurrentHorizontalResolution & "x" & objItem.CurrentVerticalResolution End If End If Next Else Set colItems = objWMIService.ExecQuery("Select ScreenHeight, ScreenWidth From Win32_DesktopMonitor",,48) For Each objItem in colItems If objItem.ScreenWidth > 0 And objItem.ScreenWidth <> "" Then If getScreenResolution = "" Then getScreenResolution = objItem.ScreenWidth & "x" & objItem.ScreenHeight Else getScreenResolution = getScreenResolution & ", " & objItem.ScreenWidth & "x" & objItem.ScreenHeight End If End If Next End If End Function Function getWidth() On Error Resume Next getWidth = "" Set colProcessors = objWMIService.ExecQuery("Select AddressWidth from Win32_Processor",,48) For Each objProcessor in colProcessors getWidth = objProcessor.AddressWidth Next End Function Function GetDeviceID(MonitorKey) On Error Resume Next Dim strTag, ThisEDID, tmpEDIDDev1, strEDID, tmpEDIDDev2 GetDeviceID = "" ThisEDID = GetEDID(MonitorKey) strEDID = ThisEDID(0) If strEDID = "{ERROR}" Then GetDeviceID = "" Exit Function End if tmpEDIDDev1 = Hex(Asc(Mid(strEDID, &H0a + 1, 1))) tmpEDIDDev2 = Hex(Asc(Mid(strEDID, &H0b + 1, 1))) If Len(tmpEDIDDev1) = 1 Then tmpEDIDDev1 = "0" & tmpEDIDDev1 If Len(tmpEDIDDev2) = 1 Then tmpEDIDDev2 = "0" & tmpEDIDDev2 GetDeviceID = tmpEDIDDev2 & tmpEDIDDev1 End Function Function GetMonitorModel(MonitorKey) On Error Resume Next Dim strTag, ThisEDID, strEDID GetMonitorModel = "" ThisEDID = GetEDID(MonitorKey) strEDID = ThisEDID(0) If strEDID = "{ERROR}" Then GetMonitorModel = "" Exit Function End if strTag = Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&Hfc) GetMonitorModel = GetDescriptorBlockFromEDID(strEDID, strTag) End Function Function GetMonitorDate(MonitorKey) On Error Resume Next Dim strEDID, ThisEDID, tmpmfgweek, tmpmfgyear GetMonitorDate = "" ThisEDID = GetEDID(MonitorKey) strEDID = ThisEDID(0) If strEDID = "{ERROR}" Then GetMonitorDate = "" Exit Function End if tmpmfgweek = Asc(Mid(strEDID, &H10 + 1, 1)) tmpmfgyear = Asc(Mid(strEDID,&H11 + 1, 1)) + 1990 GetMonitorDate = MonthName(Month(DateAdd("ww", tmpmfgweek, DateValue("1/1/" & tmpmfgyear)))) & " " & tmpmfgyear End Function Function GetMonitorSerialNumber(MonitorKey) On Error Resume Next Dim strTag, ThisEDID, strEDID GetMonitorSerialNumber = "" ThisEDID = GetEDID(MonitorKey) strEDID = ThisEDID(0) If strEDID = "{ERROR}" Then GetMonitorSerialNumber = "" Exit Function End if strTag = Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&Hff) GetMonitorSerialNumber = GetDescriptorBlockFromEDID(strEDID, strTag) End Function Function GetMonitorMake(MonitorKey) On Error Resume Next Dim ThisEDID, strTag, strEDID, tmpEDIDMfg, Char1, Char2, Char3, Byte1, Byte2, tmpmfg GetMonitorMake = "" ThisEDID = GetEDID(MonitorKey) strEDID = ThisEDID(0) If strEDID = "{ERROR}" Then GetMonitorMake = "" Exit Function End If tmpEDIDMfg = Mid(strEDID, &H08 + 1, 2) Char1 = 0 : Char2 = 0 : Char3 = 0 Byte1 = Asc(Left(tmpEDIDMfg,1)) Byte2 = Asc(Right(tmpEDIDMfg,1)) if (Byte1 And 64) > 0 Then Char1 = Char1 + 16 if (Byte1 And 32) > 0 Then Char1 = Char1 + 8 if (Byte1 And 16) > 0 Then Char1 = Char1 + 4 if (Byte1 And 8) > 0 Then Char1 = Char1 + 2 if (Byte1 And 4) > 0 Then Char1 = Char1 + 1 if (Byte1 And 2) > 0 Then Char2 = Char2 + 16 if (Byte1 And 1) > 0 Then Char2 = Char2 + 8 if (Byte2 And 128) > 0 Then Char2 = Char2 + 4 if (Byte2 And 64) > 0 Then Char2 = Char2 + 2 if (Byte2 And 32) > 0 Then Char2 = Char2 + 1 Char3 = Char3 + (Byte2 And 16) Char3 = Char3 + (Byte2 And 8) Char3 = Char3 + (Byte2 And 4) Char3 = Char3 + (Byte2 And 2) Char3 = Char3 + (Byte2 And 1) tmpmfg = Chr(Char1 + 64) & Chr(Char2 + 64) & Chr(Char3 + 64) GetMonitorMake = tmpmfg End Function Function GetDescriptorBlockFromEDID(strEDID, strTag) On Error Resume Next Dim arrDescriptorBlock(3), strFoundBlock, strResult GetDescriptorBlockFromEDID = "" If strEDID = "{ERROR}" Then GetDescriptorBlockFromEDID = "" Exit Function End If arrDescriptorBlock(0) = Mid(strEDID,&H36 + 1, 18) arrDescriptorBlock(1) = Mid(strEDID,&H48 + 1, 18) arrDescriptorBlock(2) = Mid(strEDID,&H5a + 1, 18) arrDescriptorBlock(3) = Mid(strEDID,&H6c + 1, 18) If InStr(arrDescriptorBlock(0), strTag) > 0 Then strFoundBlock = arrDescriptorBlock(0) ElseIf InStr(arrDescriptorBlock(1),strTag) > 0 Then strFoundBlock=arrDescriptorBlock(1) ElseIf InStr(arrDescriptorBlock(2),strTag)>0 Then strFoundBlock=arrDescriptorBlock(2) ElseIf InStr(arrDescriptorBlock(3),strTag)>0 Then strFoundBlock=arrDescriptorBlock(3) Else GetDescriptorBlockFromEDID = "" Exit function End if strResult = Right(strFoundBlock,14) If InStr(strResult,Chr(&H0a)) > 0 Then strResult = Trim(Left(strResult,InStr(strResult, Chr(&H0a)) - 1)) Else strResult = Trim(strResult) End if If Left(strResult,1) = Chr(0) Then strResult=Right(strResult,Len(strResult)-1) End If GetDescriptorBlockFromEDID = strResult End Function Function GetMonitorCount(ActiveMonitorArray) On Error Resume Next GetMonitorCount = 0 If UBound(ActiveMonitorArray) = 0 And ActiveMonitorArray(0) = "{ERROR}" Then GetMonitorCount = 0 Else GetMonitorCount = UBound(ActiveMonitorArray) + 1 End If End Function Function GetActiveMonitors() On Error Resume Next Dim arrAllDisplays, arrAllMonitors, strFormattedMonitorInfo arrAllDisplays = GetAllDisplayDevicesInReg() arrAllMonitors = GetAllMonitorsFromAllDisplays(arrAllDisplays) GetActiveMonitors = GetActiveMonitorsFromAllMonitors(arrAllMonitors) End Function Function GetAllDisplayDevicesInReg() On Error Resume Next GetAllDisplayDevicesInReg = False Dim arrResult(), intArrResultIndex, arrtmpkeys, arrtmpkeys2, tmpctr2, tmpctr, DISPLAY_REGKEY DISPLAY_REGKEY = "HKLM\SYSTEM\CurrentControlSet\Enum\DISPLAY\" Redim arrResult(0) intArrResultIndex = -1 arrtmpkeys = RegEnumKeys(DISPLAY_REGKEY) If vartype(arrtmpkeys) <> 8204 Then arrResult(0) = "{ERROR}" GetAllDisplayDevicesInReg = False Else For tmpctr = 0 To UBound(arrtmpkeys) arrtmpkeys2 = RegEnumKeys(DISPLAY_REGKEY & arrtmpkeys(tmpctr)) For tmpctr2 = 0 to UBound(arrtmpkeys2) intArrResultIndex = intArrResultIndex + 1 Redim Preserve arrResult(intArrResultIndex) arrResult(intArrResultIndex) = DISPLAY_REGKEY & arrtmpkeys(tmpctr) & "\" & arrtmpkeys2(tmpctr2) Next Next End If GetAllDisplayDevicesInReg = arrResult End Function Function GetAllMonitorsFromAllDisplays(arrRegKeys) On Error Resume Next Dim arrResult(), intArrResultIndex, tmpctr Redim arrResult(0) intArrResultIndex = -1 For tmpctr = 0 To UBound(arrRegKeys) If IsDisplayDeviceAMonitor(arrRegKeys(tmpctr)) Then intArrResultIndex = intArrResultIndex + 1 Redim Preserve arrResult(intArrResultIndex) arrResult(intArrResultIndex) = arrRegKeys(tmpctr) End If Next If intArrResultIndex = -1 Then arrResult(0) = "{ERROR}" End if GetAllMonitorsFromAllDisplays = arrResult End Function Function GetActiveMonitorsFromAllMonitors(arrRegKeys) On Error Resume Next Dim arrResult(), intArrResultIndex, tmpctr Redim arrResult(0) GetActiveMonitorsFromAllMonitors = "" intArrResultIndex = -1 For tmpctr = 0 To UBound(arrRegKeys) If IsMonitorActive(arrRegKeys(tmpctr)) Then intArrResultIndex = intArrResultIndex + 1 Redim Preserve arrResult(intArrResultIndex) arrResult(intArrResultIndex) = arrRegKeys(tmpctr) End If Next If intArrResultIndex = -1 Then arrResult(0) = "{ERROR}" End If GetActiveMonitorsFromAllMonitors = arrResult End Function Function IsMonitorActive(strMonitorRegKey) On Error Resume Next Dim arrtmpResult, strtmpResult arrtmpResult = RegEnumKeys(strMonitorRegKey) strtmpResult = "\|\|\|" & join(arrtmpResult,"\|\|\|") & "\|\|\|" If InStr(lcase(strtmpResult), "\|\|\|control\|\|\|") = 0 Then IsMonitorActive = False Else IsMonitorActive = True End If End Function Function GetEDID(RegKey) On Error Resume Next Dim arrResult(), strtmpResult Redim arrResult(0) strtmpResult = GetEDIDForMonitor(RegKey) Redim Preserve arrResult(0) arrResult(0) = strtmpResult GetEDID = arrResult End Function Function GetEDIDForMonitor(strMonitorRegKey) On Error Resume Next Dim arrtmpResult, bytevalue, strtmpResult arrtmpResult = RegGetBinaryValue(strMonitorRegKey & "\Device Parameters", "EDID") If vartype(arrtmpResult) <> 8204 Then GetEDIDForMonitor = "{ERROR}" Else For Each bytevalue In arrtmpResult strtmpResult = strtmpResult & Chr(bytevalue) Next GetEDIDForMonitor = strtmpResult End If End Function Function RegGetBinaryValue(RegKey,RegValueName) On Error Resume Next Dim hive, tmpreturn, objReg, strKeyPath, RegValue hive = SetHive(RegKey) Set objReg = GetWMIRegProvider() strKeyPath = Right(RegKey, Len(RegKey) - InStr(RegKey, "\")) tmpreturn = objReg.GetBinaryValue(Hive, strKeyPath, RegValueName, RegValue) If tmpreturn = 0 Then RegGetBinaryValue = RegValue Else RegGetBinaryValue = "~{{<ERROR>}}~" End If End Function Function SetHive(RegKey) On Error Resume Next Dim strHive strHive = Left(RegKey,InStr(RegKey,"\")) If strHive = "HKCR\" Or strHive="HKR\" Then SetHive = HKEY_CLASSES_ROOT If strHive = "HKCU\" Then SetHive = HKEY_CURRENT_USER If strHive = "HKCC\" Then SetHive = HKEY_CURRENT_CONFIG if strHive = "HKLM\" Then SetHive = HKEY_LOCAL_MACHINE if strHive = "HKU\" Then SetHive = HKEY_USERS End Function Function GetWMIRegProvider() On Error Resume Next Set GetWMIRegProvider=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv") End Function Function IsDisplayDeviceAMonitor(strDisplayRegKey) On Error Resume Next Dim arrtmpResult, strtmpResult arrtmpResult = RegGetMultiStringValue(strDisplayRegKey, "HardwareID") strtmpResult = "\|\|\|" & join(arrtmpResult,"\|\|\|") & "\|\|\|" If InStr(Lcase(strtmpResult), "\|\|\|monitor\") = 0 Then IsDisplayDeviceAMonitor = False Else IsDisplayDeviceAMonitor = True End if End Function Function RegGetMultiStringValue(RegKey,RegValueName) On Error Resume Next Dim objReg, hive, strKeyPath, tmpreturn, RegValue hive = SetHive(RegKey) Set objReg = GetWMIRegProvider() strKeyPath = Right(RegKey, Len(RegKey) - InStr(RegKey,"\")) tmpreturn = objReg.GetMultiStringValue(Hive, strKeyPath, RegValueName, RegValue) If tmpreturn = 0 Then RegGetMultiStringValue = RegValue Else RegGetMultiStringValue = "~{{<ERROR>}}~" End If End Function Function RegEnumKeys(RegKey) On Error Resume Next Dim hive, objReg, strKeyPath, arrSubKeys hive = SetHive(RegKey) Set objReg = GetWMIRegProvider() strKeyPath = Right(RegKey, Len(RegKey) - InStr(RegKey,"\")) objReg.EnumKey Hive, strKeyPath, arrSubKeys RegEnumKeys = arrSubKeys End Function Function getGraphicsCardName() On Error Resume Next getGraphicsCardName = "" WMIGraphicsCardName = "" RegCard0 = "" RegCard1 = "" RegCard2 = "" gcount = 0 Set colItems = objWMIService.ExecQuery("SELECT Name from Win32_VideoController WHERE (AdapterRAM IS NOT NULL OR Name LIKE '%VMware%')",,48) For each objItem in colItems If objItem.Name <> "" Then If gcount = 0 Then Video0 = objItem.Name WMIGraphicsCardName = objItem.Name Else WMIGraphicsCardName = WMIGraphicsCardName & ", " & objItem.Name End If If gcount = 1 Then Video1 = objItem.Name ElseIf gcount = 2 Then Video2 = objItem.Name End If gcount = gcount + 1 End If Next VCCount = gcount RegCard0 = RegGetStringValue("SYSTEM\CurrentControlSet\Control\Class\{4d36e968-e325-11ce-bfc1-08002be10318}\0000","DriverDesc") RegCard1 = RegGetStringValue("SYSTEM\CurrentControlSet\Control\Class\{4d36e968-e325-11ce-bfc1-08002be10318}\0001","DriverDesc") RegCard2 = RegGetStringValue("SYSTEM\CurrentControlSet\Control\Class\{4d36e968-e325-11ce-bfc1-08002be10318}\0002","DriverDesc") If NVL(Video0,"") <> "" Then If NVL(Video0,"") = NVL(RegCard0,"") Then card0 = 0 ElseIf NVL(Video0,"") = NVL(RegCard1,"") Then card0 = 1 ElseIf NVL(Video0,"") = NVL(RegCard2,"") Then card0 = 2 Else card0 = "" End If End If If NVL(Video1,"") <> "" Then If NVL(Video1,"") = NVL(RegCard0,"") Then card1 = 0 ElseIf NVL(Video1,"") = NVL(RegCard1,"") Then card1 = 1 ElseIf NVL(Video1,"") = NVL(RegCard2,"") Then card1 = 2 Else card1 = "" End If End If If NVL(Video2,"") <> "" Then If NVL(Video1,"") = NVL(RegCard0,"") Then card2 = 0 ElseIf NVL(Video1,"") = NVL(RegCard1,"") Then card2 = 1 ElseIf NVL(Video1,"") = NVL(RegCard2,"") Then card2 = 2 Else card2 = "" End If End If If WMIGraphicsCardName = "" Then Set colItems = objWMIService.ExecQuery("Select * from Win32_DisplayConfiguration",,48) For each objItem in colItems If objItem.DeviceName <> "" Then getGraphicsCardName = objItem.DeviceName End If Next Else getGraphicsCardName = WMIGraphicsCardName End If End Function Function getGraphicsMemory() On Error Resume Next getGraphicsMemory = "" vcount = 0 WMIGraphicsMemory = "" ReservedRAM = Round(CDbl(Abs(getInstalledRam() - getRam())) / 1024 / 1024) VideoRam0 = RegGetQWORDValue("SYSTEM\CurrentControlSet\Control\Class\{4d36e968-e325-11ce-bfc1-08002be10318}\0000","HardwareInformation.qwMemorySize") VideoRam1 = RegGetQWORDValue("SYSTEM\CurrentControlSet\Control\Class\{4d36e968-e325-11ce-bfc1-08002be10318}\0001","HardwareInformation.qwMemorySize") VideoRam2 = RegGetQWORDValue("SYSTEM\CurrentControlSet\Control\Class\{4d36e968-e325-11ce-bfc1-08002be10318}\0002","HardwareInformation.qwMemorySize") VR0 = Round(CDbl(Abs(NVL(VideoRam0,0))) / 1024 / 1024) VR1 = Round(CDbl(Abs(NVL(VideoRam1,0))) / 1024 / 1024) VR2 = Round(CDbl(Abs(NVL(VideoRam2,0))) / 1024 / 1024) If card0 = "0" Then If VR0 = 0 Then getGraphicsMemory = ReservedRAM & "MB" Else getGraphicsMemory = VR0 & "MB" End If ElseIf card0 = "1" Then If VR1 = 0 Then getGraphicsMemory = ReservedRAM & "MB" Else getGraphicsMemory = VR1 & "MB" End If ElseIf card0 = "2" Then If VR2 = 0 Then getGraphicsMemory = ReservedRAM & "MB" Else getGraphicsMemory = VR2 & "MB" End If End If If card1 = "0" Then if VR0 = 0 Then getGraphicsMemory = getGraphicsMemory & ", " & ReservedRAM & "MB" Else getGraphicsMemory = getGraphicsMemory & ", " & VR0 & "MB" End If ElseIf card1 = "1" Then If VR1 = 0 Then getGraphicsMemory = getGraphicsMemory & ", " & ReservedRAM & "MB" Else getGraphicsMemory = getGraphicsMemory & ", " & VR1 & "MB" End If ElseIf card1 = "2" Then If VR2 = 0 Then getGraphicsMemory = getGraphicsMemory & ", " & ReservedRAM & "MB" Else getGraphicsMemory = getGraphicsMemory & ", " & VR2 & "MB" End If End If If card2 = "0" Then if VR0 = 0 Then getGraphicsMemory = getGraphicsMemory & ", " & ReservedRAM & "MB" Else getGraphicsMemory = getGraphicsMemory & ", " & VR0 & "MB" End If ElseIf card2 = "1" Then If VR1 = 0 Then getGraphicsMemory = getGraphicsMemory & ", " & ReservedRAM & "MB" Else getGraphicsMemory = getGraphicsMemory & ", " & VR1 & "MB" End If ElseIf card2 = "2" Then If VR2 = 0 Then getGraphicsMemory = getGraphicsMemory & ", " & ReservedRAM & "MB" Else getGraphicsMemory = getGraphicsMemory & ", " & VR2 & "MB" End If End If End Function Function getGraphicsDriverVersion() On Error Resume Next getGraphicsDriverVersion = "" WMIGraphicsDriverVersion = "" vcount = 0 Set colItems = objWMIService.ExecQuery("SELECT DriverVersion, DriverDate FROM Win32_VideoController WHERE (AdapterRAM IS NOT NULL OR Name LIKE '%VMware%')",,48) For each objItem in colItems If Not IsNull(objItem.DriverVersion) And objItem.DriverVersion <> "" Then If vcount = 0 Then WMIGraphicsDriverVersion = objItem.DriverVersion & " (" & Mid(objItem.DriverDate, 7, 2) & "/" & Mid(objItem.DriverDate, 5, 2) & "/" & Left(objItem.DriverDate, 4) & ")" Else WMIGraphicsDriverVersion = WMIGraphicsDriverVersion & ", " & objItem.DriverVersion & " (" & Mid(objItem.DriverDate, 7, 2) & "/" & Mid(objItem.DriverDate, 5, 2) & "/" & Left(objItem.DriverDate, 4) & ")" End If vcount = vcount + 1 End If Next If vcount = 1 Then DriverVersion = RegGetStringValue("SYSTEM\CurrentControlSet\Control\Class\{4d36e968-e325-11ce-bfc1-08002be10318}\0000","DriverVersion") DriverDate = RegGetStringValue("SYSTEM\CurrentControlSet\Control\Class\{4d36e968-e325-11ce-bfc1-08002be10318}\0000","DriverDate") ddate = Split(DriverDate, "-") If Ubound(ddate) > 1 Then getGraphicsDriverVersion = DriverVersion & " (" & LPad(ddate(1)) & "/" & LPad(ddate(0)) & "/" & ddate(2) & ")" Else getGraphicsDriverVersion = DriverVersion End If ElseIf vcount >= 2 Then DriverVersion0 = RegGetStringValue("SYSTEM\CurrentControlSet\Control\Class\{4d36e968-e325-11ce-bfc1-08002be10318}\0000","DriverVersion") DriverVersion1 = RegGetStringValue("SYSTEM\CurrentControlSet\Control\Class\{4d36e968-e325-11ce-bfc1-08002be10318}\0001","DriverVersion") DriverDate0 = RegGetStringValue("SYSTEM\CurrentControlSet\Control\Class\{4d36e968-e325-11ce-bfc1-08002be10318}\0000","DriverDate") DriverDate1 = RegGetStringValue("SYSTEM\CurrentControlSet\Control\Class\{4d36e968-e325-11ce-bfc1-08002be10318}\0001","DriverDate") ddate0 = Split(DriverDate0, "-") ddate1 = Split(DriverDate1, "-") If Ubound(ddate0) > 1 Then getGraphicsDriverVersion = DriverVersion0 & " (" & LPad(ddate0(1)) & "/" & LPad(ddate0(0)) & "/" & ddate0(2) & ")" Else getGraphicsDriverVersion = DriverVersion0 End If If Ubound(ddate1) > 1 Then getGraphicsDriverVersion = getGraphicsDriverVersion & ", " & DriverVersion1 & " (" & LPad(ddate1(1)) & "/" & LPad(ddate1(0)) & "/" & ddate1(2) & ")" Else getGraphicsDriverVersion = getGraphicsDriverVersion & ", " & DriverVersion1 End If If vcount >= 3 Then DriverVersion2 = RegGetStringValue("SYSTEM\CurrentControlSet\Control\Class\{4d36e968-e325-11ce-bfc1-08002be10318}\0002","DriverVersion") DriverDate2 = RegGetStringValue("SYSTEM\CurrentControlSet\Control\Class\{4d36e968-e325-11ce-bfc1-08002be10318}\0002","DriverDate") ddate2 = Split(DriverDate2, "-") If Ubound(ddate2) > 1 And Not IsNull(DriverVersion2) And DriverVersion2 <> "" Then getGraphicsDriverVersion = getGraphicsDriverVersion & ", " & DriverVersion2 & " (" & LPad(ddate2(1)) & "/" & LPad(ddate2(0)) & "/" & ddate2(2) & ")" ElseIf Not IsNull(DriverVersion2) And DriverVersion2 <> "" Then getGraphicsDriverVersion = getGraphicsDriverVersion & ", " & DriverVersion2 End If End If Else getGraphicsDriverVersion = WMIGraphicsDriverVersion End If End Function Function GetKey(rpk) On Error Resume Next Const rpkOffset = 52 Dim ii, jj, dwAccumulator, szPossibleChars, szProductKey, zProductKey ii = 28 szPossibleChars = "BCDFGHJKMPQRTVWXY2346789" Do dwAccumulator = 0 jj = 14 Do dwAccumulator = dwAccumulator * 256 dwAccumulator = rpk(jj + rpkOffset) + dwAccumulator rpk(jj + rpkOffset) = (dwAccumulator \ 24) And 255 dwAccumulator = dwAccumulator Mod 24 jj = jj - 1 Loop While jj >= 0 ii = ii-1 szProductKey = mid(szPossibleChars, dwAccumulator + 1, 1)& szProductKey If (((29 - ii) Mod 6) = 0) And (ii <> -1) Then ii = ii - 1 zProductKey = "-" & szProductKey End If Loop While ii >= 0 GetKey = szProductKey End Function Function GetLicenseStatus() On Error Resume Next GetLicenseStatus = "Unknown" If OSVersion >= 6.2 Then Set colItems = objWMIService.ExecQuery("Select LicenseStatus FROM SoftwareLicensingProduct WHERE Name LIKE 'Windows%' AND LicenseStatus > 0 AND PartialProductKey <> ''") lStat = 0 For Each objItem In colItems If Not ISNull(objItem.LicenseStatus) And objItem.LicenseStatus > 0 Then lStat = objItem.LicenseStatus End If Next Select Case lStat Case 0 strSLPLicenseStatus = "Unlicensed" Case 1 strSLPLicenseStatus = "Activated" Case 2 strSLPLicenseStatus = "Out-Of-Box Grace Period" Case 3 strSLPLicenseStatus = "Out-Of-Tolerance Grace Period" Case 4 strSLPLicenseStatus = "Non-Genuine Grace Period" Case 5 strSLPLicenseStatus = "Notification Period" Case 6 strSLPLicenseStatus = "Extended Grace" Case Else strSLPLicenseStatus = lStat End Select GetLicenseStatus = strSLPLicenseStatus ElseIf OSVersion >= 6.0 Then If objOSType = "x86" Then strProductKey = GetKey(objShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId")) strPartialPK = Right("0" & strProductKey, 5) Set colSLP = objWMIService.ExecQuery("SELECT LicenseStatus FROM SoftwareLicensingProduct WHERE PartialProductKey = '" & strPartialPK & "'",,48) For Each objSLP in colSLP Select Case objSLP.LicenseStatus Case "0" strSLPLicenseStatus = "Unlicensed" Case "1" strSLPLicenseStatus = "Activated" Case "2" strSLPLicenseStatus = "Out-Of-Box Grace Period" Case "3" strSLPLicenseStatus = "Out-Of-Tolerance Grace Period" Case "4" strSLPLicenseStatus = "Non-Genuine Grace Period" Case "5" strSLPLicenseStatus = "Notification Period" Case "6" strSLPLicenseStatus = "Extended Grace" Case Else strSLPLicenseStatus = objSLP.LicenseStatus End Select Next GetLicenseStatus = strSLPLicenseStatus Else Set objCtx = CreateObject("WbemScripting.SWbemNamedValueSet") objCtx.Add "__ProviderArchitecture", 64 Set objLocator = CreateObject("Wbemscripting.SWbemLocator") Set objServices = objLocator.ConnectServer("","root\default","","",,,,objCtx) Set objStdRegProv = objServices.Get("StdRegProv") Set Inparams = objStdRegProv.Methods_("GetStringValue").Inparameters Inparams.Hdefkey = HKEY_LOCAL_MACHINE Inparams.Ssubkeyname = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\" Inparams.Svaluename = "DigitalProductId" Set Outparams = objStdRegProv.ExecMethod_("GetBinaryValue", Inparams,,objCtx) strProductKey = GetKey(Outparams.uValue) strPartialPK = Right("0" & strProductKey, 5) Set colSLP = objWMIService.ExecQuery("SELECT LicenseStatus FROM SoftwareLicensingProduct WHERE PartialProductKey = '" & strPartialPK & "'",,48) For Each objSLP in colSLP Select Case objSLP.LicenseStatus Case "0" strSLPLicenseStatus = "Unlicensed" Case "1" strSLPLicenseStatus = "Activated" Case "2" strSLPLicenseStatus = "Out-Of-Box Grace Period" Case "3" strSLPLicenseStatus = "Out-Of-Tolerance Grace Period" Case "4" strSLPLicenseStatus = "Non-Genuine Grace Period" Case "5" strSLPLicenseStatus = "Notification Period" Case "6" strSLPLicenseStatus = "Extended Grace" Case Else strSLPLicenseStatus = objSLP.LicenseStatus End Select Next GetLicenseStatus = strSLPLicenseStatus End If Else GetLicenseStatus = "" End If End Function Function LPad(numb) On Error Resume Next numb = CInt(numb) If numb < 10 Then LPad = "0" & numb Else LPad = numb End If End Function Function Maxx(a,b) Maxx = a If b > a Then Maxx = b End Function Function GetLastWindowsUpdateDate() On Error Resume Next GetLastWindowsUpdateDate = "" If OSVersion >= 6.1 Then Set QFEcollection = objWMIService.ExecQuery ("Select HotFixID, InstalledOn from win32_QuickFixEngineering",,48) LastUpdate = "" For Each QFE In QFEcollection If QFE.HotFixID <> "File 1" Then InDate = Split(QFE.InstalledOn, "/") If UBound(InDate) = 2 Then UpdDate = InDate(2) & LPad(InDate(0)) & LPad(InDate(1)) Else UpdDate = "" End If LastUpdate = Maxx(LastUpdate, UpdDate) End If Next If LastUpdate <> "" Then GetLastWindowsUpdateDate = Mid(LastUpdate, 7, 2) & "/" & Mid(LastUpdate, 5, 2) & "/" & Left(LastUpdate, 4) End If Else If objOSType = "x86" Then wlud = Left(objShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WindowsUpdate\Auto Update\Results\Install\LastSuccessTime"), 10) If wlud = "Invalid ro" or wlud = "Unable to " Then GetLastWindowsUpdateDate = "" Else dtArray = Split(wlud, "-") GetLastWindowsUpdateDate = dtArray(2) & "/" & dtArray(1) & "/" & dtArray(0) End If Else strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\WindowsUpdate\Auto Update\Results\Install\" Set objCtx = CreateObject("WbemScripting.SWbemNamedValueSet") objCtx.Add "__ProviderArchitecture", 64 Set objLocator = CreateObject("Wbemscripting.SWbemLocator") Set objServices = objLocator.ConnectServer("","root\default","","",,,,objCtx) Set objStdRegProv = objServices.Get("StdRegProv") Set Inparams = objStdRegProv.Methods_("GetStringValue").Inparameters Inparams.Hdefkey = HKEY_LOCAL_MACHINE Inparams.Ssubkeyname = strKeyPath Inparams.Svaluename = "LastSuccessTime" Set Outparams = objStdRegProv.ExecMethod_("GetStringValue", Inparams,,objCtx) wlud = Left(Outparams.SValue, 10) If wlud = "Invalid ro" or wlud = "Unable to " Then GetLastWindowsUpdateDate = "" Else dtArray = Split(wlud, "-") GetLastWindowsUpdateDate = dtArray(2) & "/" & dtArray(1) & "/" & dtArray(0) End If End If End If End Function Function getmydat(wmitime) On Error Resume Next getmydat = "" Set dtmInstallDate = CreateObject("WbemScripting.SWbemDateTime") dtmInstallDate.Value = wmitime getmydat = dtmInstallDate.GetVarDate End Function Function GetWindowsInstallDate() On Error Resume Next GetWindowsInstallDate = "" Dim dateOffset, InsDate, InDate, InstDate, Xdate Set colOperatingSystems = objWMIService.ExecQuery ("Select InstallDate from Win32_OperatingSystem",,48) For Each objOperatingSystem in colOperatingSystems InstDate = getmydat(objOperatingSystem.InstallDate) Next Xdate = Split(InstDate, " ") InDate = Split(Xdate(0), "/") If UBound(InDate) >= 2 Then GetWindowsInstallDate = "" & LPad(InDate(0)) & "/" & LPad(InDate(1)) & "/" & InDate(2) Else GetWindowsInstallDate = "" End If End Function Function BytesToString(Bytes) Result = "" If Not IsNull(Bytes) Then For N = 0 To UBound(Bytes) If CInt(Bytes(N)) <> 0 Then Result = Result & Chr(Bytes(N)) Else Exit For End If Next End If BytesToString = Result End Function Function getLocalPrinters() On Error Resume Next Dim localPrinters, colItems, NonPrinters, objItem, ii, IsPrinter getLocalPrinters = "" localPrinters = "" Set colItems = objWMIService.ExecQuery("SELECT Attributes, DriverName, Name, PortName, ServerName, DetectedErrorState FROM Win32_Printer",,48) Const PRINTER_ATTRIBUTE_LOCAL = 64 Const PRINTER_Offline = 9 NonPrinters = Array("Adobe PDF", "Adobe PDF Converter", "Bullzip PDF Printer", "Canon MX430 series FAX", "CutePDF Writer", "Disc Publisher XRP", "doPDF v7", "doPDF 7 Printer Driver", "Fax", "hpfax1", "Fax - HP Officejet 4620 series", "Journal Note Writer", "Microsoft Office Document Image Writer Driver", "Microsoft Shared Fax Driver", "Microsoft XPS Document Writer", "Microsoft XPS Document Writer v4", "Nitro PDF Creator", "Nitro PDF Driver", "novaPDF 6 Printer Driver", "Nuance Image Printer Driver", "PageManager PDF Writer", "PaperPort Image Printer", "PDF Report Writer", "PDFill Writer", "PrimoPDF", "Remote Desktop Easy Print", "PDFill PDF&Image Writer", "PrimoPDF", "Remote Desktop Easy Print", "RightFax Fax Printer", "Send to Microsoft OneNote 15 Driver", "Send To Microsoft OneNote 2010 Driver", "Send To OneNote 2007", "Send To OneNote 2010 Driver", "Send To OneNote 2013 Driver", "Send To Microsoft OneNote Driver", "SMART Notebook Document Writer", "SMART Print Capture Driver", "Snagit 10 Printer", "Snagit 11 Printer", "Snagit 12 Printer", "SnagIt 8 Printer", "OneNote") For Each objItem in colItems If (objItem.Attributes And PRINTER_ATTRIBUTE_LOCAL) And (IsNull(objItem.ServerName) Or objItem.ServerName = "") And IsNull(objItem.Name) = False And InStr(objItem.Name, "redirected") = 0 And InStr(objItem.DriverName, "fax") = 0 And InStr(objItem.DriverName, "PDF") = 0 And InStr(LCase(objItem.DriverName), "onenote") = 0 And InStr(LCase(objItem.PortName), "onenote") = 0 Then IsPrinter = 1 For ii = 0 To Ubound(NonPrinters) If objItem.Name = NonPrinters(ii) Then IsPrinter = 0 Exit For End If Next If IsPrinter = 1 Then localPrinters = localPrinters & objItem.Name If IsNull(objItem.PortName) Then localPrinters = localPrinters & "" Else localPrinters = localPrinters & " @ " & objItem.PortName End If If objItem.DetectedErrorState And PRINTER_Offline Then localPrinters = localPrinters & " (off-line)<br>" Else localPrinters = localPrinters & "<br>" End If End If End If Next getLocalPrinters = localPrinters End Function Function getEmbeddedKey() On Error Resume Next getEmbeddedKey = "" On Error Resume Next Set colItems = objWMIService.ExecQuery("Select OA3xOriginalProductKey from SoftwareLicensingService",,48) For Each objItem in colItems Key = objItem.OA3xOriginalProductKey Next getEmbeddedKey = Key End Function Function ConvertToKey7(Key) Const KeyOffset = 52 i = 28 Chars = "BCDFGHJKMPQRTVWXY2346789" Do Cur = 0 x = 14 Do Cur = Cur * 256 Cur = Key(x + KeyOffset) + Cur Key(x + KeyOffset) = (Cur \ 24) And 255 Cur = Cur Mod 24 x = x -1 Loop While x >= 0 i = i -1 KeyOutput = Mid(Chars, Cur + 1, 1) & KeyOutput If (((29 - i) Mod 6) = 0) And (i <> -1) Then i = i -1 KeyOutput = "-" & KeyOutput End If Loop While i >= 0 ConvertToKey7 = KeyOutput End Function Function ConvertToKey8(Key) Const KeyOffset = 52 Dim isWin8, Maps, i, j, Current, KeyOutput, Last, keypart1, insert 'Check if OS is Windows 8 isWin8 = (Key(66) \ 6) And 1 Key(66) = (Key(66) And &HF7) Or ((isWin8 And 2) * 4) i = 24 Maps = "BCDFGHJKMPQRTVWXY2346789" Do Current= 0 j = 14 Do Current = Current * 256 Current = Key(j + KeyOffset) + Current Key(j + KeyOffset) = (Current \ 24) Current = Current Mod 24 j = j - 1 Loop While j >= 0 i = i -1 KeyOutput = Mid(Maps, Current + 1, 1) & KeyOutput Last = Current Loop While i >= 0 keypart1 = Mid(KeyOutput, 2, Last) insert = "N" KeyOutput = Replace(KeyOutput, keypart1, keypart1 & insert, 2, 1, 0) If Last = 0 Then KeyOutput = insert & KeyOutput ConvertToKey8 = Mid(KeyOutput, 1, 5) & "-" & Mid(KeyOutput, 6, 5) & "-" & Mid(KeyOutput, 11, 5) & "-" & Mid(KeyOutput, 16, 5) & "-" & Mid(KeyOutput, 21, 5) End Function Function GetKeyXP(Key) Const rpkOffset = 52: i = 28 szPossibleChars = "BCDFGHJKMPQRTVWXY2346789" Do dwAccumulator=0 : j=14 Do dwAccumulator = dwAccumulator * 256 dwAccumulator = Key(j+rpkOffset) + dwAccumulator Key(j + rpkOffset) = (dwAccumulator \ 24) and 255 dwAccumulator = dwAccumulator Mod 24 j = j - 1 Loop While j >= 0 i = i - 1 : szProductKey = Mid(szPossibleChars, dwAccumulator + 1, 1) & szProductKey If (((29 - i) Mod 6) = 0) and (i <> -1) Then i = i - 1 : szProductKey = "-" & szProductKey End If Loop While i >= 0 GetKeyXP = szProductKey End Function Function getProductKey() On Error Resume Next getProductKey = "" If objOSType = "x86" Then Set objCtx = CreateObject("WbemScripting.SWbemNamedValueSet") objCtx.Add "__ProviderArchitecture", 32 Set objLocator = CreateObject("Wbemscripting.SWbemLocator") Set objServices = objLocator.ConnectServer("","root\default","","",,,,objCtx) Set objStdRegProv = objServices.Get("StdRegProv") Set Inparams = objStdRegProv.Methods_("GetStringValue").Inparameters Inparams.Hdefkey = HKEY_LOCAL_MACHINE Inparams.Ssubkeyname = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\" Inparams.Svaluename = "DigitalProductId" Set Outparams = objStdRegProv.ExecMethod_("GetBinaryValue", Inparams,,objCtx) BinaryKey = Outparams.uValue Else Set objCtx = CreateObject("WbemScripting.SWbemNamedValueSet") objCtx.Add "__ProviderArchitecture", 64 Set objLocator = CreateObject("Wbemscripting.SWbemLocator") Set objServices = objLocator.ConnectServer("","root\default","","",,,,objCtx) Set objStdRegProv = objServices.Get("StdRegProv") Set Inparams = objStdRegProv.Methods_("GetStringValue").Inparameters Inparams.Hdefkey = HKEY_LOCAL_MACHINE Inparams.Ssubkeyname = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\" Inparams.Svaluename = "DigitalProductId" Set Outparams = objStdRegProv.ExecMethod_("GetBinaryValue", Inparams,,objCtx) BinaryKey = Outparams.uValue End If If OSVersion = 6.1 Then getProductKey = ConvertToKey7(BinaryKey) ElseIf OSVersion > 6.1 Then getProductKey = ConvertToKey8(BinaryKey) ElseIf OSVersion >= 5 and OSVersion < 6.1 Then getProductKey = GetKeyXP(BinaryKey) End If End Function Function GetDefenderLastUpdated() On Error Resume Next Dim Result, strRetVal, objReg GetDefenderLastUpdated = "" If objOSType = "x64" Then strKeyPath = "SOFTWARE\Microsoft\Microsoft Antimalware\Signature Updates" strKeyName = "SignaturesLastUpdated" BinaryVal = Read64RegistryBinary(strKeyPath, strKeyName) If Not IsNull(BinaryVal) Then GetDefenderLastUpdated = BinaryToDate(BinaryVal) Else strKeyName = "SignaturesLastChecked" BinaryVal = Read64RegistryBinary(strKeyPath, strKeyName) If Not IsNull(BinaryVal) Then GetDefenderLastUpdated = BinaryToDate(BinaryVal) Else GetDefenderLastUpdated = "" End if End If Else Set objCtx = CreateObject("WbemScripting.SWbemNamedValueSet") objCtx.Add "__ProviderArchitecture", 32 Set objLocator = CreateObject("Wbemscripting.SWbemLocator") Set objServices = objLocator.ConnectServer("","root\default","","",,,,objCtx) Set objStdRegProv = objServices.Get("StdRegProv") Set Inparams = objStdRegProv.Methods_("GetStringValue").Inparameters Inparams.Hdefkey = HKEY_LOCAL_MACHINE Inparams.Ssubkeyname = "SOFTWARE\Microsoft\Microsoft Antimalware\Signature Updates\" Inparams.Svaluename = "SignaturesLastUpdated" Set Outparams = objStdRegProv.ExecMethod_("GetBinaryValue", Inparams,,objCtx) BinaryVal = Outparams.uValue If Not IsNull(BinaryVal) Then GetDefenderLastUpdated = BinaryToDate(BinaryVal) End If End If If GetDefenderLastUpdated = "" Then DefenderIsDisabled = RegGetDWORDValue("SOFTWARE\Microsoft\Windows Defender","DisableAntiVirus") If IsNull(DefenderIsDisabled) Or DefenderIsDisabled = 0 Then If objOSType = "x64" Then strKeyPath = "SOFTWARE\Microsoft\Windows Defender\Signature Updates" strKeyName = "SignaturesLastUpdated" BinaryVal = Read64RegistryBinary(strKeyPath, strKeyName) If Not IsNull(BinaryVal) Then GetDefenderLastUpdated = BinaryToDate(BinaryVal) Else strKeyName = "SignaturesLastChecked" BinaryVal = Read64RegistryBinary(strKeyPath, strKeyName) If Not IsNull(BinaryVal) Then GetDefenderLastUpdated = BinaryToDate(BinaryVal) Else GetDefenderLastUpdated = "" End if End If Else Set objCtx = CreateObject("WbemScripting.SWbemNamedValueSet") objCtx.Add "__ProviderArchitecture", 32 Set objLocator = CreateObject("Wbemscripting.SWbemLocator") Set objServices = objLocator.ConnectServer("","root\default","","",,,,objCtx) Set objStdRegProv = objServices.Get("StdRegProv") Set Inparams = objStdRegProv.Methods_("GetStringValue").Inparameters Inparams.Hdefkey = HKEY_LOCAL_MACHINE Inparams.Ssubkeyname = "SOFTWARE\Microsoft\Windows Defender\Signature Updates\" Inparams.Svaluename = "SignaturesLastUpdated" Set Outparams = objStdRegProv.ExecMethod_("GetBinaryValue", Inparams,,objCtx) BinaryVal = Outparams.uValue If Not IsNull(BinaryVal) Then GetDefenderLastUpdated = BinaryToDate(BinaryVal) End If End If End If End If End Function Function Read64RegistryBinary(strKeyPath, strKeyName) On Error Resume Next Read64RegistryBinary = Null Set objCtx = CreateObject("WbemScripting.SWbemNamedValueSet") objCtx.Add "__ProviderArchitecture", 64 Set objLocator = CreateObject("Wbemscripting.SWbemLocator") Set objServices = objLocator.ConnectServer("","root\default","","",,,,objCtx) Set objStdRegProv = objServices.Get("StdRegProv") Set Inparams = objStdRegProv.Methods_("GetBinaryValue").Inparameters Inparams.hDefKey = HKEY_LOCAL_MACHINE Inparams.sSubKeyName = strKeyPath Inparams.sValueName = strKeyName Set Outparams = objStdRegProv.ExecMethod_("GetBinaryValue", Inparams,,objCtx) If IsNull(Outparams.uValue) Then Read64RegistryBinary = Null Else Read64RegistryBinary = Outparams.uValue End If End Function Function BinaryToDate(bArray) On Error Resume Next Dim Seconds, Days, dateTime Set dateTime = CreateObject("WbemScripting.SWbemDateTime") Seconds = bArray(7) * (2 ^ 56) + bArray(6) * (2 ^ 48) + bArray(5) * (2^40) + bArray(4) * (2 ^ 32) + bArray(3) * (2 ^ 24) + bArray(2) * (2 ^ 16) + bArray(1) * (2^8) + bArray(0) Days = Seconds / (1E7 * 86400) dateTime.SetVarDate CDate(DateSerial(1601, 1, 1) + Days ), False BinaryToDate = LPad(dateTime.Day) & "/" & LPad(dateTime.Month) & "/" & dateTime.Year End Function Function getUpTime() On Error Resume Next Set colSettings = objWMIService.ExecQuery("Select LastBootUpTime, LocalDateTime from Win32_OperatingSystem",,48) For Each objOperatingSystem in colSettings upTime = objOperatingSystem.LastBootUpTime loTime = objOperatingSystem.LocalDateTime Exit For Next LastBoot = CDate(Mid(upTime, 7, 2) & "/" & Mid(upTime, 5, 2) & "/" & Left(upTime, 4) & " " & Mid(upTime, 9, 2) & ":" & Mid(upTime, 11, 2) & ":" & Mid(upTime,13, 2)) localTime = CDate(Mid(loTime, 7, 2) & "/" & Mid(loTime, 5, 2) & "/" & Left(loTime, 4) & " " & Mid(loTime, 9, 2) & ":" & Mid(loTime, 11, 2) & ":" & Mid(loTime,13, 2)) ElaspsedTime = DateDiff("s", LastBoot, localTime) If ElaspsedTime < 0 Then getUpTime = "" ElseIf ElaspsedTime < 60 Then getUpTime = ElaspsedTime & " seconds" ElseIf ElaspsedTime < 3600 Then upMins = Int(ElaspsedTime / 60) upSecs = ElaspsedTime mod 60 getUpTime = upMins & " minutes, " & upSecs & " seconds" ElseIf ElaspsedTime < 86400 Then upHours = Int(ElaspsedTime / 3600) upSecs = ElaspsedTime mod 3600 upMins = Int(upSecs / 60) upSecs = upSecs mod 60 getUpTime = upHours & " hours, " & upMins & " minutes, " & upSecs & " seconds" Else upDays = Int(ElaspsedTime / 86400) upSecs = ElaspsedTime mod 86400 upHours = Int(upSecs / 3600) upSecs = upSecs mod 3600 upMins = Int(upSecs / 60) upSecs = upSecs mod 60 getUpTime = upDays & " days, " & upHours & " hours, " & upMins & " minutes, " & upSecs & " seconds" End If End Function Function GetCurrentUser() On Error Resume Next GetCurrentUser = "" UserName = objNetwork.UserName Domain = objNetwork.UserDomain If Domain <> "" Then GetCurrentUser = Domain & "\" & UserName Else GetCurrentUser = UserName End If End Function Set colOSPlatform = objWMIService.ExecQuery("Select SystemType from Win32_ComputerSystem") For Each objOSPlatform in colOSPlatform objOSType = Lcase(Trim(Mid(objOSPlatform.SystemType, 1, 3))) Next Function bounce() If (xx + dx) > (intHorizontal - ww) Or (xx + dx) < 0 Then dx = dx * -1 End If If (yy + dy) > (intVertical - hh) Or (yy + dy) < 0 Then dy = dy * -1 End If xx = xx + dx yy = yy + dy Window.MoveTo xx, yy zz = Window.setTimeout("bounce()", interval) End Function Function showmake() cname.InnerHtml = objNetwork.ComputerName & " " Manufacturer = getMake() make.InnerHtml = Manufacturer & " " model.InnerHtml = getModel() & " " serialno.InnerHtml = getSerialNumber() & " " BIOS = getBIOSdate() biosdt.InnerHtml = Mid(BIOS,7,2) & "/" & Mid(BIOS,5,2) & "/" & Left(BIOS,4) & " " biosv.InnerHtml = getBIOSversion() & " " document.title = document.title & " - " & LCase(GetCurrentUser()) msg2.InnerHtml = "Retrieving System Information. Please wait." x = setTimeout("showcpu()", 1) End Function Function showcpu() CPUCount = getCPUCount() CPUspeed = getCPUspeed() / 1000 CPUname = CStr(getCPU()) If InStr(1, CPUname, "GHz") > 0 Then If CPUCount > 1 Then cpu.InnerHtml = Trim(CPUname & " x " & CPUCount) Else cpu.InnerHtml = Trim(CPUname) End If Else If CPUCount > 1 Then cpu.InnerHtml = Trim(CPUname & " @ " & FormatNumber(CPUspeed, 2) & "GHz" & " x " & CPUCount) Else cpu.InnerHtml = Trim(CPUname & " @ " & FormatNumber(CPUspeed, 2) & "GHz") End If End If cores = getCores() Threads = getLogicalCPUs() If cores = 0 Then cores = CPUCount CPUCount = 1 'Else ' cores = cores * CPUCount End If If Threads > cores Then cores = cores & " (" & Threads & " threads)" End If cpuc.InnerHtml = cores & " " msg2.InnerHtml = "Retrieving System Information. Please wait. ." x = setTimeout("showram()", 1) End Function Function showram() aram = getRam() / 1024 / 1024 / 1024 iram = getInstalledRam() / 1024 / 1024 / 1024 If iram = 0 Then iram = aram End If If Round(aram, 1) = Round(iram, 1) Then ram.InnerHtml = FormatNumber(iram, 1, -1, 0, 0) & "GB " & getRamType() Else ram.InnerHtml = FormatNumber(iram, 1, -1, 0, 0) & "GB " & getRamType() & " (" & FormatNumber(aram, 1, -1, 0, 0) & "GB available)" End If msg2.InnerHtml = "Retrieving System Information. Please wait. . ." x = setTimeout("showwin()", 1) End Function Function showwin() OSVersion = getOSversion() osname = getOSName() & " - " & getWidth() & "bit" ServicePack = getOSSP() If ServicePack <> "" and ServicePack <> "0.0" Then osname = osname & " - SP " & ServicePack End If osname = osname & " (" & getOSBuild() & ")" os.InnerHtml = osname & " " WinStatus = GetLicenseStatus() If WinStatus = "" Then winstat.style.display = "none" Else wina.InnerHtml = WinStatus & " " End If wini.InnerHtml = GetWindowsInstallDate() & " " 'winu.InnerHtml = GetLastWindowsUpdateDate() & " " msg2.InnerHtml = "Retrieving System Information. Please wait. . . ." x = setTimeout("showdisplay()", 1) prodkey = getProductKey() If prodkey <> "" Then pkeya.InnerHtml = prodkey & " " pkey.style.display = "block" End If UEFIkey = getEmbeddedKey() If UEFIkey <> "" Then ekeya.InnerHtml = UEFIkey & " " ekey.style.display = "block" End If 'OfficeK = GetOfficeProductKeys() 'If OfficeK <> "" Then ' offkey.InnerHtml = OfficeK ' office.style.display = "block" ' End If End Function Function showdisplay() card.InnerHtml = getGraphicsCardName() & " " videoram = getGraphicsMemory() If videoram = "" Then vram.style.display = "none" Else gram.InnerHtml = videoram End If resolution = getScreenResolution() If resolution = "" Then res.InnerHtml = screen.Width & "x" & screen.Height Else res.InnerHtml = resolution End If If OSVersion >= 6.1 Then Set objWMI = GetObject("winmgmts:{impersonationlevel=impersonate}!root/wmi") ii = 0 M1A = "" : M1M = "" : M1S = "" : M1D = "" : M1I = "" M2A = "" : M2M = "" : M2S = "" : M2D = "" : M2I = "" M3A = "" : M3M = "" : M3S = "" : M3D = "" : M3I = "" M4A = "" : M4M = "" : M4S = "" : M4D = "" : M4I = "" M5A = "" : M5M = "" : M5S = "" : M5D = "" : M5I = "" Set Monitors = objWMI.InstancesOf("WmiMonitorID") On Error Resume Next HasMonitor = 0 Mcount = Monitors.Count If Err.Number = 0 then HasMonitor = 1 Else Err.Clear End if On Error Resume Next If HasMonitor = 1 Then For Each Monitor In Monitors If Monitor.Active = True Then ii = ii + 1 If ii = 1 Then M1A = BytesToString(Monitor.ManufacturerName) If Monitor.UserFriendlyNameLength > 0 Then M1M = BytesToString(Monitor.UserFriendlyName) End If M1S = BytesToString(Monitor.SerialNumberID) M1W = CInt(Monitor.WeekOfManufacture) M1Y = CInt(Monitor.YearOfManufacture) If M1W > 0 And M1Y > 0 Then M1D = MonthName(Month(DateAdd("ww", M1W, DateValue("1/1/" & M1Y)))) & " " & M1Y End If End If If ii = 2 Then M2A = BytesToString(Monitor.ManufacturerName) If Monitor.UserFriendlyNameLength > 0 Then M2M = BytesToString(Monitor.UserFriendlyName) End If M2S = BytesToString(Monitor.SerialNumberID) M2W = CInt(Monitor.WeekOfManufacture) M2Y = CInt(Monitor.YearOfManufacture) If M2W > 0 And M2Y > 0 Then M2D = MonthName(Month(DateAdd("ww", M2W, DateValue("1/1/" & M1Y)))) & " " & M2Y End If End If If ii = 3 Then M3A = BytesToString(Monitor.ManufacturerName) If Monitor.UserFriendlyNameLength > 0 Then M3M = BytesToString(Monitor.UserFriendlyName) End If M3S = BytesToString(Monitor.SerialNumberID) M3W = CInt(Monitor.WeekOfManufacture) M3Y = CInt(Monitor.YearOfManufacture) If M3W > 0 And M3Y > 0 Then M3D = MonthName(Month(DateAdd("ww", M3W, DateValue("1/1/" & M3Y)))) & " " & M3Y End If End If If ii = 4 Then M4A = BytesToString(Monitor.ManufacturerName) If Monitor.UserFriendlyNameLength > 0 Then M4M = BytesToString(Monitor.UserFriendlyName) End If M4S = BytesToString(Monitor.SerialNumberID) M4W = CInt(Monitor.WeekOfManufacture) M4Y = CInt(Monitor.YearOfManufacture) If M4W > 0 And M4Y > 0 Then M4D = MonthName(Month(DateAdd("ww", M4W, DateValue("1/1/" & M4Y)))) & " " & M4Y End If End If If ii = 5 Then M5A = BytesToString(Monitor.ManufacturerName) If Monitor.UserFriendlyNameLength > 0 Then M5M = BytesToString(Monitor.UserFriendlyName) End If M5S = BytesToString(Monitor.SerialNumberID) M5W = CInt(Monitor.WeekOfManufacture) M5Y = CInt(Monitor.YearOfManufacture) If M5W > 0 And M5Y > 0 Then M5D = MonthName(Month(DateAdd("ww", M5W, DateValue("1/1/" & M5Y)))) & " " & M5Y End If End If End If Next End If Else ActiveMonitorArray = GetActiveMonitors() Monitors = GetMonitorCount(ActiveMonitorArray) If Monitors = 0 Then M1A = "" : M1M = "" : M1S = "" : M1D = "" : M1I = "" M2A = "" : M2M = "" : M2S = "" : M2D = "" : M2I = "" M3A = "" : M3M = "" : M3S = "" : M3D = "" : M3I = "" M4A = "" : M4M = "" : M4S = "" : M4D = "" : M4I = "" M5A = "" : M5M = "" : M5S = "" : M5D = "" : M5I = "" Else M1A = GetMonitorMake(ActiveMonitorArray(0)) M1M = GetMonitorModel(ActiveMonitorArray(0)) M1S = GetMonitorSerialNumber(ActiveMonitorArray(0)) M1D = GetMonitorDate(ActiveMonitorArray(0)) M1I = GetDeviceID(ActiveMonitorArray(0)) If Monitors > 1 Then M2A = GetMonitorMake(ActiveMonitorArray(1)) M2M = GetMonitorModel(ActiveMonitorArray(1)) M2S = GetMonitorSerialNumber(ActiveMonitorArray(1)) M2D = GetMonitorDate(ActiveMonitorArray(1)) M2I = GetDeviceID(ActiveMonitorArray(1)) Else M2A = "" : M2M = "" : M2S = "" : M2D = "" : M2I = "" End If If Monitors > 2 Then M3A = GetMonitorMake(ActiveMonitorArray(2)) M3M = GetMonitorModel(ActiveMonitorArray(2)) M3S = GetMonitorSerialNumber(ActiveMonitorArray(2)) M3D = GetMonitorDate(ActiveMonitorArray(2)) M3I = GetDeviceID(ActiveMonitorArray(2)) Else M3A = "" : M3M = "" : M3S = "" : M3D = "" : M3I = "" End If If Monitors > 3 Then M4A = GetMonitorMake(ActiveMonitorArray(3)) M4M = GetMonitorModel(ActiveMonitorArray(3)) M4S = GetMonitorSerialNumber(ActiveMonitorArray(3)) M4D = GetMonitorDate(ActiveMonitorArray(3)) M4I = GetDeviceID(ActiveMonitorArray(3)) Else M4A = "" : M4M = "" : M4S = "" : M4D = "" : M4I = "" End If If Monitors > 4 Then M5A = GetMonitorMake(ActiveMonitorArray(4)) M5M = GetMonitorModel(ActiveMonitorArray(4)) M5S = GetMonitorSerialNumber(ActiveMonitorArray(4)) M5D = GetMonitorDate(ActiveMonitorArray(4)) M5I = GetDeviceID(ActiveMonitorArray(4)) Else M5A = "" : M5M = "" : M5S = "" : M5D = "" : M5I = "" End If End If If M1I = "" Then M1D = M2D : M1S = M2S : M1M = M2M : M1A = M2A : M2A = "" : M2M = "" : M2S = "" : M2D = "" ElseIf Monitors = 1 Or (M2S = M1S And M1S <> "") Then M2A = "" : M2M = "" : M2S = "" : M2D = "" End If End If If M1M = "" And M1A = "" Then d1.style.display = "none" Else If M1M = "" Then Mon1 = M1A Else Mon1 = M1M End If If M1S <> "" And M1S <> "0" Then Mon1 = Mon1 & " <i>S/N</i>: " & M1S End If If M1D <> "" Then Mon1 = Mon1 & " (" & M1D & ")" End If dis1.InnerHtml = Mon1 End If If M2M <> "" Or M2A <> "" Then d2.style.display = "block" If M2M = "" Then Mon2 = M2A Else Mon2 = M2M End If If M2S <> "" And M2S <> "0" Then Mon2 = Mon2 & " <i>S/N</i>: " & M2S End If If M2D <> "" Then Mon2 = Mon2 & " (" & M2D & ")" End If dis2.InnerHtml = Mon2 End If If M3M <> "" Or M3A <> "" Then d3.style.display = "block" If M3M = "" Then Mon3 = M3A Else Mon3 = M3M End If If M3S <> "" And M3S <> "0" Then Mon3 = Mon3 & " <i>S/N</i>: " & M3S End If If M3D <> "" Then Mon3 = Mon3 & " (" & M3D & ")" End If dis3.InnerHtml = Mon3 End If If M4M <> "" OR M4A <> "" Then d4.style.display = "block" If M4M = "" Then Mon4 = M4A Else Mon4 = M4M End If If M4S <> "" And M4S <> "0" Then Mon4 = Mon4 & " <i>S/N</i>: " & M4S End If If M4D <> "" Then Mon4 = Mon4 & " (" & M4D & ")" End If dis4.InnerHtml = Mon4 End If If M5M <> "" OR M5A <> "" Then d5.style.display = "block" If M5M = "" Then Mon5 = M5A Else Mon5 = M5M End If If M5S <> "" And M5S <> "0" Then Mon5 = Mon5 & " <i>S/N</i>: " & M5S End If If M5D <> "" Then Mon5 = Mon5 & " (" & M5D & ")" End If dis5.InnerHtml = Mon5 End If msg2.InnerHtml = "Retrieving System Information. Please wait. . . . ." x = setTimeout("showdisks()", 1) End Function Function showdisks() hddc.InnerHtml = Round(CDbl(getDiskSize("C:")) / 1024 / 1024 / 1024) & "GB (" & Round(CDbl(getDiskFree("C:")) / 1024 / 1024 / 1024) & "GB free) - " & getDiskModelFromDriveLetter("C:") For ii = 100 to 122 indx = Chr(ii) varname = Eval(inx & "drv") disksize = getDiskSize(UCase(indx) & ":") If IsNumeric(disksize) Then disksize2 = Round(CDbl(disksize) / 1024 / 1024 / 1024) If disksize2 > 0 Then varname = inx & "drv" document.getElementById(indx & "drv").style.display = "block" document.getElementById("hdd" & indx).InnerHtml = disksize2 & "GB (" & Round(CDbl(getDiskFree(UCase(indx) & ":")) / 1024 / 1024 / 1024) & "GB free) - " & getDiskModelFromDriveLetter(UCase(indx) & ":") End if End If Next msg2.InnerHtml = "Retrieving System Information. Please wait. . . . . ." x = setTimeout("shownetwork()", 1) End Function Function shownetwork() nic.InnerHtml = getNIC() & " " msg2.InnerHtml = "Retrieving System Information. Please wait. . . . . . ." x = setTimeout("shownetwork2()", 1) End Function Function shownetwork2() ip.InnerHtml = getIPAddresses() & " " subnett.InnerHtml = getSubnet() & " " gatewa.InnerHtml = getGateway() & " " mac.InnerHtml = getMacAddress() & " " dns1.InnerHtml = getDNS() & " " msg2.InnerHtml = "Retrieving System Information. Please wait. . . . . . . ." x = setTimeout("showprinters()", 1) End Function Function showprinters() printers = getLocalPrinters() If printers <> "" Then document.getElementById("prnr").style.display = "block" prn.InnerHtml = printers End If msg2.InnerHtml = "Retrieving System Information. Please wait. . . . . . . . ." x = setTimeout("showLastUpdate()", 1) End Function Function showLastUpdate() winu.InnerHtml = GetLastWindowsUpdateDate() & " " lavu = GetDefenderLastUpdated() If lavu <> "" Then document.getElementById("avu").style.display = "block" avud.InnerHtml = lavu End If If getUpTime() <> "" Then document.getElementById("wut").style.display = "block" winup.InnerHtml = getUpTime() & " " End If x = setTimeout("hidemsg()", 1) End Function Function hidemsg() cpulo.style.display = "block" riu.style.display = "block" document.getElementById("msg1").style.display = "none" helpb.style.visibility = "visible" showCurrentCPUSpeedAndFreeRAM() End Function Function getCPUusage() getCPUusage = 0 On Error Resume Next Set colItems = objWMIService.ExecQuery("Select PercentProcessorTime from Win32_PerfFormattedData_PerfOS_Processor Where Name = '_Total'",,48) For Each objItem in colItems getCPUusage = objItem.PercentProcessorTime Next End Function Function getDiskActivity() getDiskActivity = 0 On Error Resume Next Set colItems = objWMIService.ExecQuery("SELECT PercentDiskTime FROM Win32_PerfRawData_PerfDisk_PhysicalDisk WHERE Name LIKE '%C:%'",,48) For Each objItem in colItems getDiskActivity = objItem.PercentDiskTime Next End Function Function graphRAMnCPU() iram = Ceil(getRam() / 1024 / 1024 / 128) / 8 avram = getAvailableRam() / 1024 uram = iram - avram pram = uram / iram * 100 inram.InnerHtml = FormatNumber(uram, 1, -1, 0, 0) & "GB " & FormatNumber(pram, 0, -1, 0 , 0) & "%" cpuper = getCPUusage() cpum = int(cpuper) cpui = 100 - cpum If cpum = 0 Then cpul.InnerHtml = "<table cellpadding=0 border=0 cellspacing=0><tr><td width=104 style='border:1px solid black;'><table cellpadding=0 border=0 cellspacing=0><tr><td bgcolor=white width=1> </td><td bgcolor=white width=99> </td></tr></table></td><td> 0%</td></tr></table>" ElseIf cpum = 100 Then cpul.InnerHtml = "<table cellpadding=0 border=0 cellspacing=0><tr><td width=104 bgcolor=green style='border:1px solid black;'><table cellpadding=0 border=0 cellspacing=0><tr><td bgcolor=green width=99> </td><td bgcolor=green width=1> </td></tr></table></td><td> 100%</td></tr></table>" Else cpul.InnerHtml = "<table cellpadding=0 border=0 cellspacing=0><tr><td width=104 style='border:1px solid black;'><table cellpadding=0 border=0 cellspacing=0><tr><td bgcolor=green width=" & cpum & "> </td><td bgcolor=white width=" &cpui & "> </td></tr></table></td><td> " & FormatNumber(cpuper, 0, -1, 0 , 0) & "%</td></tr></table>" End If If getUpTime() <> "" Then document.getElementById("wut").style.display = "block" winup.InnerHtml = getUpTime() & " " End If End Function Function GetOfficeProductKeys() On Error Resume Next strBaseKey = "SOFTWARE\" strOfficeKey = strBaseKey & "Microsoft\Office" Set objReg2 = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv") objReg2.EnumKey HKEY_LOCAL_MACHINE, strOfficeKey, arrOfficeVersionSubKeys intProductCount = 1 OfficeKey = "" If IsArray(arrOfficeVersionSubKeys) Then For Each strOfficeVersionKey In arrOfficeVersionSubKeys Select Case strOfficeVersionKey Case "11.0" Result = CheckOfficeKey(strOfficeKey & "\11.0\Registration",52,intProductCount) If Result <> "" Then OfficeKey = OfficeKey & Result & "<br>" End If Case "12.0" Result = CheckOfficeKey(strOfficeKey & "\12.0\Registration", 52, intProductCount) If Result <> "" Then OfficeKey = OfficeKey & Result & "<br>" End If Case "14.0" Result = CheckOfficeKey(strOfficeKey & "\14.0\Registration",808,intProductCount) If Result <> "" Then OfficeKey = OfficeKey & Result & "<br>" End If Case "15.0" Result = CheckOfficeKey(strOfficeKey & "\15.0\Registration",808,intProductCount) If Result <> "" Then OfficeKey = OfficeKey & Result & "<br>" End If Case "16.0" Result = CheckOfficeKey(strOfficeKey & "\16.0\Registration",808,intProductCount) If Result <> "" Then OfficeKey = OfficeKey & Result & "<br>" End If End Select Next End If If OfficeKey = "" Then strBaseKey = "SOFTWARE\Wow6432Node\" strOfficeKey = strBaseKey & "Microsoft\Office" Set objReg2 = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv") objReg2.EnumKey HKEY_LOCAL_MACHINE, strOfficeKey, arrOfficeVersionSubKeys intProductCount = 1 If IsArray(arrOfficeVersionSubKeys) Then For Each strOfficeVersionKey In arrOfficeVersionSubKeys Select Case strOfficeVersionKey Case "11.0" Result = CheckOfficeKey(strOfficeKey & "\11.0\Registration",52,intProductCount) If Result <> "" Then OfficeKey = OfficeKey & Result & "<br>" End If Case "12.0" Result = CheckOfficeKey(strOfficeKey & "\12.0\Registration",52,intProductCount) If Result <> "" Then OfficeKey = OfficeKey & Result & "<br>" End If Case "14.0" Result = CheckOfficeKey(strOfficeKey & "\14.0\Registration",808,intProductCount) If Result <> "" Then OfficeKey = OfficeKey & Result & "<br>" End If Case "15.0" Result = CheckOfficeKey(strOfficeKey & "\15.0\Registration",808,intProductCount) If Result <> "" Then OfficeKey = OfficeKey & Result & "<br>" End If Case "16.0" Result = CheckOfficeKey(strOfficeKey & "\16.0\Registration",808,intProductCount) If Result <> "" Then OfficeKey = OfficeKey & Result & "<br>" End If End Select Next End If End If GetOfficeProductKeys = OfficeKey End Function Function CheckOfficeKey(strRegPath,intKeyOffset,intProductCount) On Error Resume Next Set objReg2 = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv") objReg2.EnumKey HKEY_LOCAL_MACHINE, strRegPath, arrOfficeRegistrations CheckOfficeKey = "" If IsArray(arrOfficeRegistrations) Then For Each strOfficeRegistration In arrOfficeRegistrations objReg2.GetStringValue HKEY_LOCAL_MACHINE,strRegPath & "\" & strOfficeRegistration,"ConvertToEdition",strOfficeEdition objReg2.GetBinaryValue HKEY_LOCAL_MACHINE,strRegPath & "\" & strOfficeRegistration,"DigitalProductID",arrProductID If strOfficeEdition <> "" And IsArray(arrProductID) Then TheKey = DecodeProductKey(arrProductID,intKeyOffset) If TheKey <> "" And TheKey <> "C2FG9-N6J68-H8BTJ-BW3QX-RM3B3" Then CheckOfficeKey = strOfficeEdition & " " & TheKey End If intProductCount = intProductCount + 1 End If Next End If End Function Function DecodeProductKey(arrKey, intKeyOffset) On Error Resume Next If Not IsArray(arrKey) Then DecodeProductKey = "" Exit Function Else intIsWin8 = BitShiftRight(arrKey(intKeyOffset + 14),3) And 1 arrKey(intKeyOffset + 14) = arrKey(intKeyOffset + 14) And 247 Or BitShiftLeft(intIsWin8 And 2,2) i = 24 strChars = "BCDFGHJKMPQRTVWXY2346789" strKeyOutput = "" While i > -1 intCur = 0 intX = 14 While intX > -1 intCur = BitShiftLeft(intCur,8) intCur = arrKey(intX + intKeyOffset) + intCur arrKey(intX + intKeyOffset) = Int(intCur / 24) intCur = intCur Mod 24 intX = intX - 1 Wend i = i - 1 strKeyOutput = Mid(strChars,intCur + 1,1) & strKeyOutput intLast = intCur Wend If intIsWin8 = 1 Then strKeyOutput = Mid(strKeyOutput,2,intLast) & "N" & Right(strKeyOutput,Len(strKeyOutput) - (intLast + 1)) End If strKeyGUIDOutput = Mid(strKeyOutput,1,5) & "-" & Mid(strKeyOutput,6,5) & "-" & Mid(strKeyOutput,11,5) & "-" & Mid(strKeyOutput,16,5) & "-" & Mid(strKeyOutput,21,5) DecodeProductKey = strKeyGUIDOutput End If End Function Function BitShiftRight(intValue,intShift) BitShiftRight = Int(intValue / (2 ^ intShift)) End Function Function BitShiftLeft(intValue,intShift) BitShiftLeft = intValue * 2 ^ intShift End Function Function showCurrentCPUSpeedAndFreeRAM() graphRAMnCPU() x = setTimeout("showCurrentCPUSpeedAndFreeRAM()", 1000) End Function Sub Window_onLoad() Call Resize_Window() showmake() 'bounce() End Sub Function showhelp() msg = "Version " & SysInfo.version & " - 12 April 2022" msg = msg & chr(10) & "Latest version at https://www.eniware.com.au/script.htm" msg = msg & chr(10) & "You can use a text editor such as Notepad to view/edit this file: " & SysInfo.document.Script.location.pathname msg = msg & chr(10) & chr(10) & "This collection of scripts works on Windows XP to Windows 11," msg = msg & " with limited functionality on earlier versions of Windows." msg = msg & " Many of the functions have been gleaned from examples found on the Internet to produce this compilation." msg = msg & " Dates are in DD/MM/YYYY format but you can modify the code to suit." msg = msg & chr(10) & chr(10) & "Copyright (c) 2022 Eniware Pty Ltd" msg = msg & chr(10) & "Permission is hereby granted, free of charge, to any person obtaining a copy of this software to use the Software without restriction." msg = msg & chr(10) & chr(10) & "The Software is provided 'AS IS', without warranty of any kind, express or implied." msg = msg & " Under no circumstances shall Eniware be liable for any loss, damage or injury" msg = msg & " (including without limitation any loss of profit, indirect, consequential or incidental loss, damage or injury)" msg = msg & " arising from the use of the Software or any failure of the Software to perform as expected." If Len(msg) > 1023 Then objShell.Popup msg, 0, "System Information", 64 Else MsgBox msg, 64, "System Information" End If End Function </script> <hta:application id="SysInfo" applicationName="System Information" singleInstance="yes" border="thick" borderStyle="normal" scroll="auto" caption="yes" maximizeButton="no" minimizeButton="no" contextMenu="yes" showInTaskBar="no", sysMenu="yes" windowState="normal" selection="yes" innerBorder="yes" scrollFlat="no" version="3.28" > <style type="text/css" media="print,screen"> body {margin:0 0 0 0;} p, td, tr, ul, ol, textarea, input, div, select {color:#000080;font-family:Verdana, Geneva, Arial, Helvetica, sans-serif;font-size:14px;} .title {font-size:20px;} .nav {font-family:Arial, Helvetica, sans-serif;font-size:12px;} </style> </head> <body marginwidth="0" marginheight="0" style="background-image: url(data:image/pjpeg;base64,/9j/4AAQSkZJRgABAgIAyADIAAD//gEChgAAAAMAAAADAAAABQAAAAcAAAANAAAAEAAAABQAAAADAAAAAwAAAAQAAAAGAAAACAAAABMAAAATAAAAEgAAAAQAAAAEAAAABQAAAAcAAAANAAAAEgAAABYAAAASAAAABAAAAAUAAAAHAAAACQAAABAAAAAcAAAAGgAAABQAAAAFAAAABwAAAAwAAAASAAAAFgAAACMAAAAhAAAAGQAAAAcAAAALAAAAEgAAABUAAAAaAAAAIgAAACUAAAAeAAAAEAAAABUAAAAZAAAAHAAAACEAAAAnAAAAJwAAACEAAAAXAAAAHgAAAB8AAAAgAAAAJAAAACAAAAAhAAAAIAAAAP/AABEIAM8AxgMBIgACEQEDEQH/2wCEAAUDAwQDAwUEBAQFBQUGBw0IBwcHBxALDAkNExAUExIQEhIVFx4ZFRYcFhISGiMaHB8gISIhFBklJyQgJx4hISABBQUFBwYHDwgIDyAVEhUVICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIP/EAaIAAAEFAQEBAQEBAAAAAAAAAAABAgMEBQYHCAkKCxAAAgEDAwIEAwUFBAQAAAF9AQIDAAQRBRIhMUEGE1FhByJxFDKBkaEII0KxwRVS0fAkM2JyggkKFhcYGRolJicoKSo0NTY3ODk6Q0RFRkdISUpTVFVWV1hZWmNkZWZnaGlqc3R1dnd4eXqDhIWGh4iJipKTlJWWl5iZmqKjpKWmp6ipqrKztLW2t7i5usLDxMXGx8jJytLT1NXW19jZ2uHi4+Tl5ufo6erx8vP09fb3+Pn6AQADAQEBAQEBAQEBAAAAAAAAAQIDBAUGBwgJCgsRAAIBAgQEAwQHBQQEAAECdwABAgMRBAUhMQYSQVEHYXETIjKBCBRCkaGxwQkjM1LwFWJy0QoWJDThJfEXGBkaJicoKSo1Njc4OTpDREVGR0hJSlNUVVZXWFlaY2RlZmdoaWpzdHV2d3h5eoKDhIWGh4iJipKTlJWWl5iZmqKjpKWmp6ipqrKztLW2t7i5usLDxMXGx8jJytLT1NXW19jZ2uLj5OXm5+jp6vLz9PX29/j5+v/aAAwDAQACEQMRAD8A+y6KKKACmySpCu52Cj3qpeaksIKxkEjq3YVlS3TyNuJOfU9a0hScjOVRRNaXVYk+6pb68Cq7a038KIPxrLznrRW6oRRi6r6GmNafuiH8amj1mNuHQr9OaxqPpTdGIKrJHSQ3EU4zG4NSVzSSOhDKSCO4rSstW5Ec30BrGdFx1RrGqnozTooBDDIORRWJqFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABVHUb0Rgxocf3iP5VZuphbwl8c9APesCeQyPyc4/WtaUOZmdSfKhruXOT07D0ptFFdmxyhWppFlFJEZZFDHOAD2rLq5Yag1mpQruQ849Kiom42RUGk9S3qtjEsHmxqFK9cd6ygMVcvdSa7QRqm1O/vVTApUk4xtIdRpvQSjHtS4orQgvabqBiYRSHKnoa1xgjIrmsVs6VdedDsb7y1y1oW95HRSnfRlyiiisDYKKKKACiiigAooooAKKKKACiiigAooooAzNYmwQgP3Rn8TWVVzVH3XD/XH6VTrtoq0TkqO8goophmVeF5Na2M20i9p1mt3IyMxUAZ4q7/AGJF/wA9HrEjuJUOUcrn04roNJd5LJGdixyeT9axrc0dUzSi4y0sVrvS47a3eRXYlR0rM3+grf1L/jxlHtWAFooyclqFZKLVhQ59BRvPpQBS7fatTHUN/tU+nz+VdKegPBqDb7UAFeV6jpUzScWi4NqSOlopsTbo1b1FOrgO4KKKKACiiigAooooAKKKKACiiigAooooAwNQ/wCPh/8AeNVWYIMmrusgRTux4HWshnMhyenYV6FFc0UcNZ8rHvIXOOg9KFFNUVIorbYw3HKK6DR+LFPqf51gqK39I/48U+p/nXNiPhOjDr3h+o/8eUn0rDC1u6h/x5yfSsVVrOhszSutUIFpQvtTwopdtbXMbEe32pCAFJ6YqXbTZVBQJj77BalyshxV3Y27YYt4x/sipKRF2oqjsMUtcR3BRRRQAUUUUAFFFFABRRRQAUUUUAFFFFAGbrtt5sAcDpwa50DBxjpXZSRiWMoRwRiuY1Cza1nKkcdq68NUt7rOTE07+8iBRUiio1qVa6mcqHqK3dJ/48l+p/nWPb20txkRJux1rb06J4bVUdcMM8Vy12uWx1UE73Fvx/okg9qyFFbN2jSW7qoySOBWW9vJCAXXGelZ0WkrF1lqNA9KcFoUU8DitTEZs9KW0i8+/UD7sQyfrSTyeRHkDLHhR6mr+m2htYPm++3LVlUlpY2pR1uWqKKKwOgKKKKACiiigAooooAKKKKACiiigAooooAKrX9il5Fgj5h0NWaKFpsFr6HKz2r2shRxikWulurOO6TawGfWse50mW3OVGVrshXTVpHHOg1rENPvvsRc7N27HfFXBrQP/LH/AMerK2leCMU9QewqpU4S1FGco6I1BrGf+WP/AI9Udzd/aVUbNuD61TVT6U/eiD5mAqOSMdUVzyehKvSlklSFct17L61HH5s5228RP+0egq9Z6WsLebM3mSep6D6VnKolsVCk3uR6fZPI4ubgYb+BP7taNFFYN3OhJJWQUUUUDCiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAhlsoJuXjXPqKgOjW/wDCXGffNXaKE7CsUP7EtzwWc/Q4qaLS7WEhliBI7nmrNFF7gkkAAUYAAFFFFAwooooAKKKKACiio5rmK3Hztz2A60WDYkorMn1gjiNVX68n8qqvqUzf8tH/ADxWipSZm6kUbtFc/wDbpf77/wDfVPTU506SH8ear2Ehe1ibtFZkGtdBKn4rV+G4jnXMbA1nKDjuWpJ7ElFFFSUFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRVW/uvs8e1ThiOvoKaV9EJuw291AQZSMjcOp7CseWdpCeTz37mmySFz7dqbXZTpqKOWc3IKAOwoq1pSo16gfHQ4+taN2VyEruxE1rMib2iYL64qKunIBGCBiuclCiVwv3dxxWVOpz6Gk6fKMAp8UzwtuRsGm49qMVq0nozNaG1Yagtyu1sBx2q5XNIWjYMpwRW5p94LqLB+8OtclWny6rY6ac+bRlmiiisTUKKKKACiiigAooooAKKKKACiiigAooooARiFUk8AVgXtwZpCSepz+HatfUZNlsQP4vlrBY7mJ9a6KEbu5jWdlYSiiiuo5wpykoQVOCOmKE2hl3Yxnmt2IWUzbYxExxnArOc+ToVCPMZTahcumwyHFQYFdB9kg/55J+VYN38t1IqjADEACopzUnZKxVSLirtjaXFMGfWjn1raxjcfipbOc206t/D3qDJ9aMn1pON1YcZWdzpgQQCOhoqtpsvm2i56rxVmvPtbQ71qFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAUNYbEaD6/yrGrY1kfu0P1FYzMEGTXXQ+E5q24vAFRtMBwtRPIZOOg9KFFdKj3OVz7D8luprR0EYvD/uH+lZ6jtWloYxeH/cP9Kmp8LXkVT+Jept1z14P9Ll/wB410NYN2P9Kk/3jXJQ+I66/wAJAFpQtOA9qcFrpuctiPbRtqTZQF5AouFjQ0U4jkXPetCs7RRxKcYw2K0a4Z/Ezuj8KCiiipKCiiigAooooAKKKKACiiigAooooAq6pHvtSQPunNcvMxaQjsDgV2LoHQqRwRiuV1C1NvcMpHQ11YWSTscuJi+W6IAKeopi1Io4rsZxoeorR0QYuz/uGqCitDRR/pZ/3DWNT4X6G1P4kbNYd0M3MmP71blYtwP9Ik/3jXLR0Z1VvhIwtOC0oFOC1vc5hmBRgKC3oM1JsGKjljMpW3XrIefYVLdkVFXdjQ0eMpZhj/Gc1cpsaCONUUYCjAp1cm52pW0CiiigAooooAKKKKACiiigAooooAKKKKACs/V7D7RF5iD5gK0KMDGKabi7oTSaszjypQ7SMYp61sappO/MsQ57isjYUO1hg16FOqprzOCdJwfkTQR+ZIiZxuIFbVlpv2SXf5m7jGMVhxsUYMpwQcira6jc/wDPU/lUVIyekSqcox1Zu1Sm07LPJv8AU4xVJdQuP+ehp/2ydhgyHB4rBUpR2N3VjLRoYoqRRUaU6SZIFy557KOprR6GCV9h0jrDGXfoP1qbSrRgTdTDDv8AdHoKZaWMlzIJ7kYUfcj/AMa0xxwKwnK+iOmnDl1CiiiszUKKKKACiiigAooooAKKKKACiiigAooooAKKKKACqt1psNyM42mrVFCdthWvoYU2lTQZIXcvtUGwocMCD6V0lIURuqg/hWyrSRk6MXsc8MDv+lOSVCPlDP8A7orc+zQ9fKT8qeqKv3VA+godZsFRSMiK2u5+FjES+rdau2umRW7b2/eP6ntVuis3Jvc0jBR2CiiipKCiiigD/9k=);"> <div style="position:absolute;width:99%;text-align:right;float:right;padding-top:2px;padding-right:2px;"><button onclick="showhelp()" id="helpb" style="width:25px;height:25px;visibility:hidden;">?</button></div> <table border="0" cellspacing="0" cellpadding="2" width="99%" align="center" id="TheTable"> <tr id="msg1"><td align="center" colspan="2" style="color:red;font-size:18px;font-weight:bold;"id="msg2">Retrieving System Information. Please wait. . </b></td></tr> <tr><td align="right" width="25%" nowrap><i>Name</i>: </td><td id="cname" width="75%"> </td></tr> <tr><td align="right" width="25%" nowrap><i>Make</i>: </td><td id="make" width="75%"> </td></tr> <tr><td align="right" width="25%" nowrap><i>Model</i>: </td><td id="model" width="75%"> </td></tr> <tr><td align="right" width="25%" nowrap><i>Serial No</i>: </td><td id="serialno" width="75%"> </td></tr> <tr><td align="right" width="25%" nowrap><i>BIOS date</i>: </td><td id="biosdt" width="75%"> </td></tr> <tr><td align="right" width="25%" nowrap><i>BIOS version</i>: </td><td id="biosv" width="75%"> </td></tr> <tr><td align="right" width="25%" nowrap><i>CPU name</i>: </td><td id="cpu" width="75%"> </td></tr> <tr id="sok" style="display:none"><td align="right" width="25%" nowrap><i>CPU sockets</i>: </td><td id="cpus" width="75%"> </td></tr> <tr><td align="right" width="25%" nowrap><i>CPU cores</i>: </td><td id="cpuc" width="75%"> </td></tr> <tr id="cpulo" style="display:none"><td align="right" width="25%" nowrap><i>CPU load</i>: </td><td id="cpul" width="75%" nowrap> </td></tr> <tr><td align="right" width="25%" nowrap><i>RAM</i>: </td><td id="ram" width="75%"> </td></tr> <tr id="riu" style="display:none"><td align="right" width="25%" nowrap><i>RAM in use</i>: </td><td id="inram" width="75%"> </td></tr> <tr><td align="right" width="25%" nowrap valign="top"><i>Windows version</i>: </td><td id="os" width="75%" valign="top"> </td></tr> <tr id="pkey" style="display:none"><td align="right" width="25%" nowrap><i>Product key</i>: </td><td id="pkeya" width="75%"> </td></tr> <tr id="ekey" style="display:none"><td align="right" width="25%" nowrap><i>Embedded key</i>: </td><td id="ekeya" width="75%"> </td></tr> <tr id="winstat"><td align="right" width="25%" nowrap><i>Windows status</i>: </td><td id="wina" width="75%"> </td></tr> <tr><td align="right" width="25%" nowrap><i>Windows installed</i>: </td><td id="wini" width="75%"> </td></tr> <tr><td align="right" width="25%" nowrap><i>Windows updated</i>: </td><td id="winu" width="75%"> </td></tr> <tr id="wut" style="display:none"><td align="right" width="25%" nowrap><i>Windows uptime</i>: </td><td id="winup" width="75%"> </td></tr> <tr id="avu" style="display:none"><td align="right" width="25%" nowrap><i>Defender updated</i>: </td><td id="avud" width="75%"> </td></tr> <tr id="office" style="display:none"><td align="right" width="25%" nowrap valign="top"><i>Microsoft Office</i>: </td><td id="offkey" width="75%" valign="top"> </td></tr> <tr><td align="right" width="25%" nowrap valign="top"><i>Graphics card</i>: </td><td id="card" width="75%" valign="top"> </td></tr> <tr id="vram"><td align="right" width="25%" nowrap><i>Graphics memory</i>: </td><td id="gram" width="75%"> </td></tr> <tr><td align="right" width="25%" nowrap><i>Display resolution</i>: </td><td id="res" width="75%"> </td></tr> <tr id="d1"><td align="right" width="25%" nowrap><i>Display 1</i>: </td><td id="dis1" width="75%"> </td></tr> <tr id="d2" style="display:none"><td align="right" width="25%" nowrap><i>Display 2</i>: </td><td id="dis2" width="75%"> </td></tr> <tr id="d3" style="display:none"><td align="right" width="25%" nowrap><i>Display 3</i>: </td><td id="dis3" width="75%"> </td></tr> <tr id="d4" style="display:none"><td align="right" width="25%" nowrap><i>Display 4</i>: </td><td id="dis4" width="75%"> </td></tr> <tr id="d5" style="display:none"><td align="right" width="25%" nowrap><i>Display 5</i>: </td><td id="dis5" width="75%"> </td></tr> <tr><td align="right" width="25%" nowrap valign="top"><i>Network adaptor</i>: </td><td id="nic" width="75%" valign="top"> </td></tr> <tr style="display:none"><td align="right" width="25%" nowrap><i>Network driver ver</i>: </td><td id="nid" width="75%"> </td></tr> <tr><td align="right" width="25%" nowrap valign="top"><i>Network MAC</i>: </td><td id="mac" width="75%" valign="top"> </td></tr> <tr><td align="right" width="25%" nowrap valign="top"><i>Network IP</i>: </td><td id="ip" width="75%" valign="top"> </td></tr> <tr><td align="right" width="25%" nowrap valign="top"><i>Subnet</i>: </td><td id="subnett" width="75%" valign="top"> </td></tr> <tr><td align="right" width="25%" nowrap valign="top"><i>Gateway</i>: </td><td id="gatewa" width="75%" valign="top"> </td></tr> <tr><td align="right" width="25%" nowrap valign="top"><i>DNS</i>: </td><td id="dns1" width="75%" valign="top"> </td></tr> <tr id="hd0" style="display:none"><td align="right" width="25%" nowrap><i>Hard disk 0</i>: </td><td id="hdd" width="75%"> </td></tr> <tr id="hd1" style="display:none"><td align="right" width="25%" nowrap><i>Hard disk 1</i>: </td><td id="hdd1" width="75%"> </td></tr> <tr id="hd2" style="display:none"><td align="right" width="25%" nowrap><i>Hard disk 2</i>: </td><td id="hdd2" width="75%"> </td></tr> <tr id="hd3" style="display:none"><td align="right" width="25%" nowrap><i>Hard disk 3</i>: </td><td id="hdd3" width="75%"> </td></tr> <tr id="hd4" style="display:none"><td align="right" width="25%" nowrap><i>Hard disk 4</i>: </td><td id="hdd4" width="75%"> </td></tr> <tr id="hd5" style="display:none"><td align="right" width="25%" nowrap><i>Hard disk 5</i>: </td><td id="hdd5" width="75%"> </td></tr> <tr id="hd6" style="display:none"><td align="right" width="25%" nowrap><i>Hard disk 6</i>: </td><td id="hdd6" width="75%"> </td></tr> <tr id="hd7" style="display:none"><td align="right" width="25%" nowrap><i>Hard disk 7</i>: </td><td id="hdd7" width="75%"> </td></tr> <tr id="hd8" style="display:none"><td align="right" width="25%" nowrap><i>Hard disk 8</i>: </td><td id="hdd8" width="75%"> </td></tr> <tr id="hd9" style="display:none"><td align="right" width="25%" nowrap><i>Hard disk 9</i>: </td><td id="hdd9" width="75%"> </td></tr> <tr><td align="right" width="25%" nowrap><i>C: drive</i>: </td><td id="hddc" width="75%"> </td></tr> <tr id="ddrv" style="display:none"><td align="right" width="25%" nowrap><i>D: drive</i>: </td><td id="hddd" width="75%"> </td></tr> <tr id="edrv" style="display:none"><td align="right" width="25%" nowrap><i>E: drive</i>: </td><td id="hdde" width="75%"> </td></tr> <tr id="fdrv" style="display:none"><td align="right" width="25%" nowrap><i>F: drive</i>: </td><td id="hddf" width="75%"> </td></tr> <tr id="gdrv" style="display:none"><td align="right" width="25%" nowrap><i>G: drive</i>: </td><td id="hddg" width="75%"> </td></tr> <tr id="hdrv" style="display:none"><td align="right" width="25%" nowrap><i>H: drive</i>: </td><td id="hddh" width="75%"> </td></tr> <tr id="idrv" style="display:none"><td align="right" width="25%" nowrap><i>I: drive</i>: </td><td id="hddi" width="75%"> </td></tr> <tr id="jdrv" style="display:none"><td align="right" width="25%" nowrap><i>J: drive</i>: </td><td id="hddj" width="75%"> </td></tr> <tr id="kdrv" style="display:none"><td align="right" width="25%" nowrap><i>K: drive</i>: </td><td id="hddk" width="75%"> </td></tr> <tr id="ldrv" style="display:none"><td align="right" width="25%" nowrap><i>L: drive</i>: </td><td id="hddl" width="75%"> </td></tr> <tr id="mdrv" style="display:none"><td align="right" width="25%" nowrap><i>M: drive</i>: </td><td id="hddm" width="75%"> </td></tr> <tr id="ndrv" style="display:none"><td align="right" width="25%" nowrap><i>N: drive</i>: </td><td id="hddn" width="75%"> </td></tr> <tr id="odrv" style="display:none"><td align="right" width="25%" nowrap><i>O: drive</i>: </td><td id="hddo" width="75%"> </td></tr> <tr id="pdrv" style="display:none"><td align="right" width="25%" nowrap><i>P: drive</i>: </td><td id="hddp" width="75%"> </td></tr> <tr id="qdrv" style="display:none"><td align="right" width="25%" nowrap><i>Q: drive</i>: </td><td id="hddq" width="75%"> </td></tr> <tr id="rdrv" style="display:none"><td align="right" width="25%" nowrap><i>R: drive</i>: </td><td id="hddr" width="75%"> </td></tr> <tr id="sdrv" style="display:none"><td align="right" width="25%" nowrap><i>S: drive</i>: </td><td id="hdds" width="75%"> </td></tr> <tr id="tdrv" style="display:none"><td align="right" width="25%" nowrap><i>T: drive</i>: </td><td id="hddt" width="75%"> </td></tr> <tr id="udrv" style="display:none"><td align="right" width="25%" nowrap><i>U: drive</i>: </td><td id="hddu" width="75%"> </td></tr> <tr id="vdrv" style="display:none"><td align="right" width="25%" nowrap><i>V: drive</i>: </td><td id="hddv" width="75%"> </td></tr> <tr id="wdrv" style="display:none"><td align="right" width="25%" nowrap><i>W: drive</i>: </td><td id="hddw" width="75%"> </td></tr> <tr id="xdrv" style="display:none"><td align="right" width="25%" nowrap><i>X: drive</i>: </td><td id="hddx" width="75%"> </td></tr> <tr id="ydrv" style="display:none"><td align="right" width="25%" nowrap><i>Y: drive</i>: </td><td id="hddy" width="75%"> </td></tr> <tr id="zdrv" style="display:none"><td align="right" width="25%" nowrap><i>Z: drive</i>: </td><td id="hddz" width="75%"> </td></tr> <tr id="prnr" style="display:none"><td align="right" width="25%" nowrap valign="top"><i>Printers</i>: </td><td id="prn" width="75%" valign="top"> </td></tr> </table> </body>

JavaScript Notice:
Either your browser does not support JavaScript or JavaScript has been disabled on your browser.
This site is interactive and requires JavaScript to pre-process your selections and transmit them to our web server.

To enable JavaScript in Microsoft Internet Explorer choose Tools from the menubar, then Internet Options, then Security. The Default level of security (medium / medium-high) enables JavaScript. In Internet Explorer 7 to 11 you may have to press the Alt key to display the menubar.

JavaScript is always enabled in Firefox unless you enter about:config in the address bar and make ill advised low level changes.

To enable JavaScript in Google Chrome, click on the 3 horizontal bars at the top right of the browser, then choose Settings, click on the Show advanced settings link at the bottom, click on the Content settings button, select Allow all sites to run JavaScript (recommended).

Your browser has identified itself as AppleWebKit 537.3. You will have to check on line for advice on enabling JavaScript.

Home Database Browser Desktop Graphing DHTML Scripting Tree Shop QCI Contact us Privacy