(view source code of hardware.hta as plain text)
<!DOCTYPE HTML>
<html lang="en">
<head>
<title>Basic Hardware Inventory</title>
<meta name="viewport" content="width=device-width; initial-scale=1" />
<HTA:APPLICATION
APPLICATIONNAME="Basic Hardware Inventory"
ID="Hardware"
VERSION="9.03"
ICON="Hardware.ico"
SCROLL="auto"
SINGLEINSTANCE="yes"
WINDOWSTATE="maximize"/>
<style type="text/css">
html {
height: 100%;
}
body {
font: 11pt arial,sans-serif;
color: black;
background-color: white;
padding: 20px 0;
margin: 0;
height: 100%;
width: 100%;
}
a {
color: red;
}
code {
color: yellow;
font-size: 110%;
}
input[type=radio] {
width: 2em;
}
table {
max-width: 100%;
}
td {
overflow-x: auto;
text-align: left;
}
tr {
vertical-align: top;
}
.Button {
height: 2em;
margin: 0 1em 0 1em;
overflow: visible;
padding: 2px;
vertical-align: middle;
width: 6em;
}
.Center {
margin-left: auto;
margin-right: auto;
text-align: center;
}
.DebugOnly {
display: none;
}
.Left {
text-align: left;
}
.Nowrap {
white-space: nowrap;
}
.Top {
vertical-align: top;
}
#CreditsScreen, #HelpScreen {
display: none;
margin: 0 auto;
max-width: 90%;
width: 800px;
}
#CreditsScreen .Button, #HelpScreen .Button {
margin: 3px;
}
#HelpScreen table tr td {
text-align: left;
}
@media screen
{
.PrintOnly {
display: none;
}
}
@media print
{
body {
font: 12pt arial,sans-serif;
color: black;
background-color: white;
filter: unset;
padding: 0;
margin: 0;
height: 100%;
}
.DontPrint {
display: none;
}
.Nowrap {
white-space: normal;
}
}
Option Explicit
' File IO constants
Const TristateFalse = 0
Const TristateMixed = -2
Const TristateTrue = -1
Const TristateUseDefault = -2
Const ForAppending = 8
Const ForReading = 1
Const ForWriting = 2
' Registry hives constants
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_CURRENT_CONFIG = &H80000005
' Registry data types constants
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_DWORD_BIG_ENDIAN = 5
Const REG_LINK = 6
Const REG_MULTI_SZ = 7
Const REG_RESOURCE_LIST = 8
Const REG_FULL_RESOURCE_DESCRIPTOR = 9
Const REG_RESOURCE_REQUIREMENTS_LIST = 10
Const REG_QWORD = 11
' Character and year to be displayed in copyrights notices
Const COPYRIGHTS_YEAR = 2024
Dim COPYRIGHTS_CHAR
COPYRIGHTS_CHAR = Chr( 169 ) ' May need correction in non-latin languages
Const KB = 1024
Const MB = 1048576 ' 1024 * 1024
Const GB = 1073741824 ' 1024 * 1024 * 1024
Const TB = 1099511627776 ' 1024 * 1024 * 1024 * 1024
' Variable to get elevation status
Dim gvbIsElevated
' Variable to hold local/remote check result
Dim gvbIsLocalComputer
' Variables to hold the command line
Dim gvsCommandline, gvsCommandlineUC
' Global File System Object
Dim gvoFSO
' Global variables to receive the WinSAT scores
Dim sngCPU, sngDisk, sngMemory, sngTotal, sngVideo
' Minimum window size
Dim gviMinHeight, gviMinWidth
' Configuration file
Dim gvsConfigFile
' Temporary files to display detailed query results and print previews
Dim gvsDetailsFile, gvsPrintFile
' Path to DMIDecode.exe
Dim gvsDMIDecode
' Dictionary objects to hold all defaults, permanent settings and session settings
Dim gvaDefaultsBool, gvaDefaultsStr, gvaSettingsBool, gvaSettingsStr
' Internet connection available?
Dim gvbConnected
gvbConnected = True
' Random generator
Dim gvoRandom
' Registry DataTypes to string
Dim gvaRegDataType(11)
gvaRegDataType(1) = "REG_SZ"
gvaRegDataType(2) = "REG_EXPAND_SZ"
gvaRegDataType(3) = "REG_BINARY"
gvaRegDataType(4) = "REG_DWORD"
gvaRegDataType(5) = "REG_DWORD_BIG_ENDIAN"
gvaRegDataType(6) = "REG_LINK"
gvaRegDataType(7) = "REG_MULTI_SZ"
gvaRegDataType(8) = "REG_RESOURCE_LIST"
gvaRegDataType(9) = "REG_FULL_RESOURCE_DESCRIPTOR"
gvaRegDataType(10) = "REG_RESOURCE_REQUIREMENTS_LIST"
gvaRegDataType(11) = "REG_QWORD"
' WMI objects for all namespaces used in this HTA
Dim gvoWMIlocalCimv2, gvoWMIrootCimv2, gvoWMIrootMSWinStorage, gvoWMIrootStandardCimv2, gvoWMIrootWMI
' Other global variables
Dim gvaCSSColors, gvaPATH, gvaVideo( )
Dim gvbSilent, gvbWinPE
Dim clrBgErr, clrTxtErr
Dim gvcBanks, gvcCPU, gvcMemory
Dim gviNumOS, gviMemSize, gviMemSpeed
Dim gvoHDDInterfaces, gvoWSHShell
Dim gvsDefaultBrowserName, gvsDefaultBrowserPath
Dim gvsBIOSSerial, gvsComputer, gvsCSVTxt, gvsDebugText, gvsDetails, gvsHeader, gvsPATH, gvsSlots, gvsWinDrive
Sub window_onload
Dim blnComputer, strFile
' Global File System and WSH Shell objects must be initialized here because they are requireded now, before Initialize( ) subroutine has run
Set gvoWSHShell = CreateObject( "WScript.Shell" )
Set gvoFSO = CreateObject( "Scripting.FileSystemObject" )
Set gvoWMIlocalCimv2 = GetObject( "winmgmts://./root/CIMV2" )
' Check if in WinPE
gvbWinPE = CheckWinPE( )
' Initialize the program window
AppVersion.innerHTML = Hardware.Version
HelpVer.innerHTML = Hardware.Version
CredVersion.innerHTML = Hardware.Version
AppYear.innerHTML = COPYRIGHTS_YEAR
document.title = "Basic Hardware Inventory (Version " & Hardware.Version & ") " & COPYRIGHTS_CHAR & " 2005 - " & COPYRIGHTS_YEAR & ", Rob van der Woude"
' Initialize the program
Initialize ' includes read and set defaults
ConfigReadFile
ConfigReadCommandline
ConfigUpdateStatus
ButtonCopy.disabled = True
ButtonPaste.disabled = False
ButtonPrint.disabled = True
ButtonSave.disabled = True
If gvaSettingsBool.Item( "BASIC" ) Then
ButtonBasic.value = "Full"
End If
CheckboxBIOS.Checked = Not gvaSettingsBool.Item( "BASIC" )
CheckboxCDROM.Checked = Not gvaSettingsBool.Item( "BASIC" )
CheckboxCPU.Checked = True
CheckboxFDD.Checked = Not gvaSettingsBool.Item( "BASIC" )
CheckboxHDD.Checked = True
CheckboxKeyboard.Checked = Not gvaSettingsBool.Item( "BASIC" )
CheckboxMainBoard.Checked = Not gvaSettingsBool.Item( "BASIC" )
CheckboxMemory.Checked = True
CheckboxMonitor.Checked = Not gvaSettingsBool.Item( "BASIC" )
CheckboxMouse.Checked = Not gvaSettingsBool.Item( "BASIC" )
CheckboxNIC.Checked = Not gvaSettingsBool.Item( "BASIC" )
CheckboxPorts.Checked = Not gvaSettingsBool.Item( "BASIC" )
CheckboxVideo.Checked = Not gvaSettingsBool.Item( "BASIC" )
CheckboxSound.Checked = Not gvaSettingsBool.Item( "BASIC" )
ButtonDetailsBIOS.disabled = True
ButtonDetailsCPU.disabled = True
ButtonDetailsCDROM.disabled = True
ButtonDetailsFDD.disabled = True
ButtonDetailsHDD.disabled = True
ButtonDetailsKeyboard.disabled = True
ButtonDetailsMainBoard.disabled = True
ButtonDetailsMemory.disabled = True
ButtonDetailsMonitor.disabled = True
ButtonDetailsMouse.disabled = True
ButtonDetailsNIC.disabled = True
ButtonDetailsPorts.disabled = True
ButtonDetailsSound.disabled = True
ButtonDetailsVideo.disabled = True
If InStr( gvsCommandlineUC, "/?" ) Or InStr( gvsCommandlineUC, "/HELP" ) Then showHelp
If gvaSettingsBool.Item( "DEVTEST" ) Then Set gvoRandom = CreateObject( "System.Random" )
window.offscreenBuffering = True
gviNumOS = GetOSVer( )
If Split( gviNumOS, "." )(0) < 8 Then
MsgBox "As of version 9.00, this HTA requires Windows 8 or later." & vbCrLf & vbCrLf & "Use Hardware.hta version 8.04 for Windows 7 or older Windows versions.", vbOKOnly + vbExclamation, "Windows version issue"
self.window.close
Exit Sub
End If
GetDefaultBrowser
If Not IsAdmin( True ) Then
Self.window.close
Exit Sub
End If
blnComputer = CBool( InStr( gvsCommandlineUC, "/COMPUTER:" ) )
gvbSilent = gvaSettingsBool.Item( "COPY" ) Or gvaSettingsBool.Item( "PRINT" ) Or ( gvaSettingsStr.Item( "SAVE" ) <> "" )
If gvbSilent Or blnComputer Then Inventory
If gvbSilent Then
If gvaSettingsBool.Item( "COPY" ) Then CopyToClipboard
If gvaSettingsBool.Item( "PRINT" ) Then Print
If gvaSettingsStr.Item( "SAVE" ) <> "" Then strFile = SaveTabDelimited( )
window.close
Exit Sub
End If
' Start a separate thread/process for the update check
setTimeout "CheckUpdate", 100, "VBScript"
ComputerName.focus
End Sub
Sub Add2CsvBIOS( )
gvsHeader = gvsHeader _
& vbTab & "BIOS Manufacturer:" _
& vbTab & "BIOS Model:" _
& vbTab & "BIOS Version:" _
& vbTab & "BIOS Date:" _
& vbTab & "BIOS Serial Number:"
On Error Resume Next ' REQUIRED
gvsCSVTxt = gvsCSVTxt & vbTab
gvsCSVTxt = gvsCSVTxt & BIOSManufacturer.value
gvsCSVTxt = gvsCSVTxt & vbTab
gvsCSVTxt = gvsCSVTxt & BIOSModel.value
gvsCSVTxt = gvsCSVTxt & vbTab
gvsCSVTxt = gvsCSVTxt & BIOSVersion.value
gvsCSVTxt = gvsCSVTxt & vbTab
gvsCSVTxt = gvsCSVTxt & BIOSDate.value
gvsCSVTxt = gvsCSVTxt & vbTab
gvsCSVTxt = gvsCSVTxt & gvsBIOSSerial
On Error GoTo 0
End Sub
Sub Add2CsvCDROM( )
Dim i
On Error Resume Next ' REQUIRED
For i = 0 To 64
gvsCSVTxt = gvsCSVTxt _
& vbTab & document.getElementById( "CDROM" & i & "Model" ).value _
& vbTab & document.getElementById( "CDROM" & i & "Firmware" ).value _
& vbTab & document.getElementById( "CDROM" & i & "Interface" ).value
If Err Then
Exit For
Else
gvsHeader = gvsHeader _
& vbTab & "CDROM " & i & " Model:" _
& vbTab & "CDROM " & i & " Firmware:" _
& vbTab & "CDROM " & i & " Interface:"
End if
Next
On Error GoTo 0
End Sub
Sub Add2CsvCPU
gvsHeader = gvsHeader _
& vbTab & "# CPUs:" _
& vbTab & "CPU Type:" _
& vbTab & "CPU Speed:" _
& vbTab & "CPU Socket:" _
& vbTab & "WinSat CPU Score:"
On Error Resume Next ' REQUIRED
gvsCSVTxt = gvsCSVTxt & vbTab
gvsCSVTxt = gvsCSVTxt & CPUNumber.value
gvsCSVTxt = gvsCSVTxt & vbTab
gvsCSVTxt = gvsCSVTxt & CPUModel.value
gvsCSVTxt = gvsCSVTxt & vbTab
gvsCSVTxt = gvsCSVTxt & CPUSpeed.value
gvsCSVTxt = gvsCSVTxt & vbTab
gvsCSVTxt = gvsCSVTxt & CPUSocket.value
gvsCSVTxt = gvsCSVTxt & vbTab
gvsCSVTxt = gvsCSVTxt & CPUScore.value
On Error GoTo 0
End Sub
Sub Add2CsvFDD( )
Dim i
On Error Resume Next ' REQUIRED
For i = 0 To 256
gvsCSVTxt = gvsCSVTxt _
& vbTab & document.getElementById( "FDD" & i & "DeviceID" ).value _
& vbTab & document.getElementById( "FDD" & i & "Description" ).value _
& vbTab & document.getElementById( "FDD" & i & "Capacity" ).value _
& vbTab & document.getElementById( "FDD" & i & "Interface" ).value
If Err Then
Exit For
Else
gvsHeader = gvsHeader _
& vbTab & "FDD " & i & " Drive:" _
& vbTab & "FDD " & i & " Description:" _
& vbTab & "FDD " & i & " Capacity:" _
& vbTab & "FDD " & i & " Interface:"
End If
Next
On Error GoTo 0
End Sub
Sub Add2CsvHDD( )
Dim i
On Error Resume Next ' REQUIRED
For i = 0 To 256
gvsCSVTxt = gvsCSVTxt _
& vbTab & document.getElementById( "HardDisk" & i & "Model" ).value _
& vbTab & document.getElementById( "HardDisk" & i & "Size" ).value _
& vbTab & document.getElementById( "HardDisk" & i & "Interface" ).value
If Err Then
Exit For
Else
gvsHeader = gvsHeader _
& vbTab & "HDD " & i & " Model:" _
& vbTab & "HDD " & i & " Size (GB):" _
& vbTab & "HDD " & i & " Interface:"
End If
Next
On Error GoTo 0
gvsHeader = gvsHeader & vbTab & "WinSat Disk Score:"
gvsCSVTxt = gvsCSVTxt & vbTab & DiskScore.value
End Sub
Sub Add2CsvKbd( )
gvsHeader = gvsHeader _
& vbTab & "Keyboard Type:" _
& vbTab & "Keyboard Model:"
On Error Resume Next ' REQUIRED
gvsCSVTxt = gvsCSVTxt & vbTab
gvsCSVTxt = gvsCSVTxt & KeyboardType.value
gvsCSVTxt = gvsCSVTxt & vbTab
gvsCSVTxt = gvsCSVTxt & KeyboardModel.value
On Error GoTo 0
End Sub
Sub Add2CsvMainBoard( )
gvsHeader = gvsHeader & vbTab _
& "Chassis:" & vbTab _
& "MB Manufacturer:" & vbTab _
& "MB Model:" & vbTab _
& "MB Version:" & vbTab _
& "WinSAT Score:"
gvsCSVTxt = gvsCSVTxt & vbTab _
& ChassisType.value & vbTab _
& MBManufacturer.value & vbTab _
& MBModel.value & vbTab _
& MBVersion.value & vbTab _
& WinSATScore.value
End Sub
Sub Add2CsvMemory
gvsHeader = gvsHeader _
& vbTab & "# Memory Banks:" _
& vbTab & "# Memory Modules:" _
& vbTab & "Total Memory (MB):" _
& vbTab & "Memory Speed (ns):" _
& vbTab & "Memory FormFactor:" _
& vbTab & "WinSat Memory Score:"
On Error Resume Next ' REQUIRED
gvsCSVTxt = gvsCSVTxt & vbTab
gvsCSVTxt = gvsCSVTxt & gvcBanks
gvsCSVTxt = gvsCSVTxt & vbTab
gvsCSVTxt = gvsCSVTxt & gvcMemory
gvsCSVTxt = gvsCSVTxt & vbTab
gvsCSVTxt = gvsCSVTxt & MemorySize.value
gvsCSVTxt = gvsCSVTxt & vbTab
gvsCSVTxt = gvsCSVTxt & MemorySpeed.value
gvsCSVTxt = gvsCSVTxt & vbTab
gvsCSVTxt = gvsCSVTxt & MemoryFormFactor.value
gvsCSVTxt = gvsCSVTxt & vbTab
gvsCSVTxt = gvsCSVTxt & MemoryScore.value
On Error GoTo 0
End Sub
Sub Add2CsvMouse( )
gvsHeader = gvsHeader _
& vbTab & "Mouse Type:" _
& vbTab & "Mouse Model:"
On Error Resume Next ' REQUIRED
gvsCSVTxt = gvsCSVTxt & vbTab
gvsCSVTxt = gvsCSVTxt & MouseType.value
gvsCSVTxt = gvsCSVTxt & vbTab
gvsCSVTxt = gvsCSVTxt & MouseModel.value
On Error GoTo 0
End Sub
Sub Add2CsvNIC
Dim i
On Error Resume Next ' REQUIRED
For i = 0 To 64
gvsCSVTxt = gvsCSVTxt _
& vbTab & document.getElementById( "NICModel" & i ).value _
& vbTab & document.getElementById( "MACAddress" & i ).value _
& vbTab & document.getElementById( "NICSpeed" & i ).value
If Err Then
Exit For
Else
gvsHeader = gvsHeader _
& vbTab & "NIC " & i & " Model (and medium):" _
& vbTab & "NIC " & i & " MAC Address:" _
& vbTab & "NIC " & i & " Speed:"
End if
Next
On Error GoTo 0
End Sub
Sub Add2CsvPorts
gvsHeader = gvsHeader _
& vbTab & "USB:" _
& vbTab & "System Slots:" _
& vbTab & "Parallel Ports:" _
& vbTab & "Serial Ports:"
On Error Resume Next ' REQUIRED
gvsCSVTxt = gvsCSVTxt & vbTab
gvsCSVTxt = gvsCSVTxt & USB.value
gvsCSVTxt = gvsCSVTxt & vbTab
gvsCSVTxt = gvsCSVTxt & gvsSlots
gvsCSVTxt = gvsCSVTxt & vbTab
gvsCSVTxt = gvsCSVTxt & Parallel.value
gvsCSVTxt = gvsCSVTxt & vbTab
gvsCSVTxt = gvsCSVTxt & Serial.value
On Error GoTo 0
End Sub
Sub Add2CsvSound
gvsHeader = gvsHeader _
& vbTab & "Sound Card Model:" _
& vbTab & "Sound Card Manufacturer:"
On Error Resume Next ' REQUIRED
gvsCSVTxt = gvsCSVTxt & vbTab
gvsCSVTxt = gvsCSVTxt & SoundCardManufacturer.value
gvsCSVTxt = gvsCSVTxt & vbTab
gvsCSVTxt = gvsCSVTxt & SoundCardModel.value
On Error GoTo 0
End Sub
Sub Add2CsvVideo( )
Dim i
On Error Resume Next ' REQUIRED
For i = 0 To 32
gvsCSVTxt = gvsCSVTxt _
& vbTab & document.getElementById( "VideoModel" & i ).value _
& vbTab & document.getElementById( "VideoMemory" & i ).value _
& vbTab & document.getElementById( "VideoMode" & i ).value
If Err Then
Exit For
Else
gvsHeader = gvsHeader _
& vbTab & "Video " & i & " Model:" _
& vbTab & "Video " & i & " Memory (MB):" _
& vbTab & "Video " & i & " Mode:"
End If
Next
gvsCSVTxt = gvsCSVTxt & vbTab & GraphicsScore.value
gvsHeader = gvsHeader & vbTab & "WinSat Graphics Score:"
On Error GoTo 0
End Sub
Function Align( myString, myLength )
Align = Left( myString & Space( myLength ), myLength )
End Function
Sub Basic( )
gvaSettingsBool.Item( "BASIC" ) = Not gvaSettingsBool.Item( "BASIC" )
CheckboxBIOS.Checked = Not gvaSettingsBool.Item( "BASIC" )
CheckboxCDROM.Checked = Not gvaSettingsBool.Item( "BASIC" )
CheckboxCPU.Checked = True
CheckboxHDD.Checked = True
CheckboxFDD.Checked = Not gvaSettingsBool.Item( "BASIC" )
CheckboxKeyboard.Checked = Not gvaSettingsBool.Item( "BASIC" )
CheckboxMainBoard.Checked = Not gvaSettingsBool.Item( "BASIC" )
CheckboxMemory.Checked = True
CheckboxMonitor.Checked = Not gvaSettingsBool.Item( "BASIC" )
CheckboxMouse.Checked = Not gvaSettingsBool.Item( "BASIC" )
CheckboxNIC.Checked = Not gvaSettingsBool.Item( "BASIC" )
CheckboxPorts.Checked = Not gvaSettingsBool.Item( "BASIC" )
CheckboxVideo.Checked = Not gvaSettingsBool.Item( "BASIC" )
CheckboxSound.Checked = Not gvaSettingsBool.Item( "BASIC" )
If gvaSettingsBool.Item( "BASIC" ) Then
ButtonBasic.value = "Full"
ButtonBasic.accessKey = "f"
Else
ButtonBasic.value = "Basic"
ButtonBasic.accessKey = "b"
End If
End Sub
Function Chain( myCharList )
Dim intChar, strChar, strCharChain
Chain = ""
If Not IsArray( myCharList ) Then
If InStr( myCharList, ";" ) Then
myCharList = Split( myCharList, ";" )
ElseIf InStr( myCharList, "," ) Then
myCharList = Split( myCharList, "," )
Else
Exit Function
End If
End If
For Each intChar In myCharList
If CInt( intChar ) = 0 Then
' Uncomment next line to abort at first null character
' Exit For
' Comment next line when aborting at first null character
strChar = " "
Else
strChar = Chr( intChar )
End If
strCharChain = strCharChain & strChar
Next
Chain = Trim( strCharChain )
End Function
Function CheckComputerName( myComputerName )
Dim blnReady, colItems, objItem, objWMIService, strComputerName
strComputerName = UCase( myComputerName )
CheckComputerName = ""
blnReady = False
If Not gvbWinPE Then
strComputerName = GetHostName( strComputerName )
If strComputerName = "" Then
MsgBox "Error while trying to ping computer " & strComputerName, vbOKOnly, "Connection Error"
Reset
Exit Function
End If
End If
CheckComputerName = strComputerName
End Function
Sub CheckDMIDecode( )
Dim blnFound, i
blnFound = False
If gvbWinPE Then Exit Sub
For i = 0 To UBound( gvaPATH )
With gvoFSO
gvsDMIDecode = .BuildPath( gvaPATH(i), "dmidecode.exe" )
If .FileExists( gvsDMIDecode ) Then
blnFound = True
Exit For
End If
End With
Next
gvaSettingsBool.Item( "DMIDECODE" ) = gvaSettingsBool.Item( "DMIDECODE" ) And blnFound
CheckboxDMIDecode.disabled = Not blnFound
DebugMessage "", "DMIDecode found: " & CStr( blnFound )
End Sub
Sub CheckKey( )
' Backspace
If SettingsScreen.style.display = "none" And MainScreen.style.display = "none" Then ' Not in Settings or Main screen
If Self.window.event.keyCode = 8 Then
ShowMain ' BackSpace => Back to main window
End If
End If
' Escape
If Self.window.event.keyCode = 27 Then
ShowMain ' Esc => Back to main window
End If
' Enter
If Not MainScreen.style.display = "none" Then ' In Main screen
If Self.window.event.keyCode = 13 Then
Inventory ' Enter => Start inventory
End If
End if
If Self.window.event.altKey Then
If Self.window.event.keyCode = 68 Then ' Alt+d, toggle Debug mode
gvaSettingsBool.Item( "DEBUG" ) = Not gvaSettingsBool.Item( "DEBUG" )
ConfigUpdateStatus
End If
End If
End Sub
Sub CheckUpdate( )
Dim intAnswer, intButtons, lenLatestVer, strCurrentVer, strLatestver, strPrompt, strTitle
If Not gvaSettingsBool.Item( "NOUPD" ) And Not gvbWinPE Then
' Change cursor to hourglass while checking for update
Document.Body.style.Cursor = "wait"
intButtons = vbYesNoCancel + vbApplicationModal + vbInformation
strCurrentVer = Split( Hardware.Version )(0)
strLatestVer = TextFromHTML( "https://www.robvanderwoude.com/updates/hardware.txt" )
If strCurrentVer <> strLatestver Then
On Error Resume Next ' REQUIRED
' Clear the IE cache
gvoWSHShell.Run "RUNDll32.EXE InetCpl.cpl,ClearMyTracksByProcess 8", 7, True
' Try again, read the latest version info from the web
strLatestver = TextFromHTML( "https://www.robvanderwoude.com/updates/hardware.txt" )
On Error Goto 0
End If
DebugMessage "Check for Update", Align( "Connected to Internet:", 25 ) & gvbConnected & vbCrLf & Align( "Current Version:", 25 ) & strCurrentVer & vbCrLf & Align( "Latest Version:", 25 ) & strLatestver & vbCrLf
If gvbConnected Then
lenLatestVer = Len( strLatestVer )
If lenLatestVer >= 4 And lenLatestVer <= 6 Then
If strLatestVer < strCurrentVer Then
strTitle = "Unofficial version"
strPrompt = "You seem to be using a pre-release version (" & strCurrentVer & ") of Hardware.hta." _
& vbCrLf & vbCrLf _
& "The latest official release is " & strLatestver _
& vbCrLf & vbCrLf _
& "Do you want to download the latest official release?"
intAnswer = MsgBox( strPrompt, intButtons + vbDefaultButton2, strTitle )
If intAnswer = vbYes Then
gvoWSHShell.Run "https://www.robvanderwoude.com/hardware.php", 7, False
End If
End If
If strLatestVer > strCurrentVer Then
strTitle = "Old version"
strPrompt = "You are using version " & strCurrentVer & " of Hardware.hta." _
& vbCrLf & vbCrLf _
& "The latest official release is " & strLatestver _
& vbCrLf & vbCrLf _
& "Do you want to download the latest official release?"
intAnswer = MsgBox( strPrompt, intButtons, strTitle )
If intAnswer = vbYes Then
gvoWSHShell.Run "https://www.robvanderwoude.com/hardware.php", 7, False
End If
End If
Else
strTitle = "Update Check Failure"
strPrompt = "Unable to check for updates." _
& vbCrLf & vbCrLf _
& "Do you want to ""manually"" check for updates now?"
intAnswer = MsgBox( strPrompt, intButtons, strTitle )
If intAnswer = vbYes Then
gvoWSHShell.Run "https://www.robvanderwoude.com/hardware.php", 7, False
End If
End If
End If
' Change cursor back to default
Document.Body.style.Cursor = "default"
End If
End Sub
Function CheckWinPE( )
' Check if running in WinPE environment
' Based on a tip by Mitch Tulloch
' http://techgenix.com/HowtodetectwhetheryouareinWindowsPE/
Dim arrKeys, blnWinPE, colItems, i, objItem, objReg, objWMIService
blnWinPE = False
Set objReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!//./root/default:StdRegProv" )
objReg.EnumKey HKEY_LOCAL_MACHINE, "SYSTEM\ControlSet001\Control", arrKeys
For i = 0 To UBound( arrKeys )
If UCase( arrKeys(i) ) = "MININT" Then
blnWinPE = True
Exit For
End If
Next
Set objReg = Nothing
If blnWinPE Then
' Find computer name when in WinPE
' Based on code by Richie Schuster
' http://www.sccmog.com/get-current-old-machine-name-winpe-vbscript/
Set objWMIService = GetObject( "winmgmts://./root/CIMV2" )
Set colItems = objWMIService.ExecQuery ( "Select * From Win32_LogicalDisk" )
gvsWinDrive = ""
For Each objItem in colItems
' Find Windows system drive (won't work if Windows folder is renamed)
If gvoFSO.FolderExists( gvoFSO.BuildPath( objItem.DeviceID, "Windows\System32\config" ) ) Then
gvsWinDrive = objItem.DeviceID
End If
Next
Set colItems = Nothing
If gvsWinDrive <> "" Then
' Mount registry hive from Windows Drive
gvoWSHShell.Run "CMD.EXE /C REG.EXE Load HKLM\TempHive " & gvsWinDrive & "\windows\system32\config\system", 0, True
' Read computer name from mounted registry hive
gvsComputer = wshShell.RegRead( "HKEY_LOCAL_MACHINE\TempHive\ControlSet001\Control\ComputerName\ComputerName" )
' Unmount temporary registry hive
gvoWSHShell.Run "CMD.EXE /C REG.EXE Unload HKLM\TempHive", 0, True
End If
Set objWMIService = Nothing
End If
CheckWinPE = blnWinPE
End Function
Sub ConfigReadCommandline( )
Dim objRE
Dim strDebug, strItem, strKey, strSubItem
For Each strKey In gvaSettingsBool.Keys
If InStr( gvsCommandlineUC, "/" & UCase( strKey ) ) Then gvaSettingsBool.Item( strKey ) = True
Next
strItem = GetParameter( gvsCommandline, "COMPUTER" )
If strItem <> "" Then gvaSettingsStr.Item( "COMPUTER" ) = UCase( strItem )
strItem = GetParameter( gvsCommandline, "SAVE" )
If strItem <> "" Then
With gvoFSO
strItem = .GetAbsolutePathName( strItem )
If .FolderExists( .GetParentFolderName( strItem ) ) Then
gvaSettingsStr.Item( "SAVE" ) = strItem
Else
gvaSettingsStr.Item( "SAVE" ) = ""
End If
End With
End If
strItem = GetParameter( gvsCommandline, "TEMPDIR" )
If strItem <> "" And gvoFSO.FolderExists( strItem ) Then
gvaSettingsStr.Item( "TEMPDIR" ) = strItem
End If
strItem = GetParameter( gvsCommandline, "THEME" )
Select Case UCase( strItem )
Case "BW":
gvaSettingsStr.Item( "THEME" ) = "ThemeBW"
Case "BLUE":
gvaSettingsStr.Item( "THEME" ) = "ThemeBlue"
Case "CUSTOM":
gvaSettingsStr.Item( "THEME" ) = "ThemeCustom"
Case "DARK":
gvaSettingsStr.Item( "THEME" ) = "ThemeDark"
Case "DEFAULT":
gvaSettingsStr.Item( "THEME" ) = "ThemeBW"
Case "RED":
gvaSettingsStr.Item( "THEME" ) = "ThemeRed"
End Select
strSubItem = GetParameter( gvsCommandline, "CUSTOMCOLORS" )
If ( strItem = "" Or gvaSettingsStr.Item( "THEME" ) = "ThemeCustom" ) And strSubItem <> "" Then
gvaSettingsStr.Item( "CUSTOMCOLORS" ) = LCase( strSubItem )
gvaSettingsStr.Item( "THEME" ) = "ThemeCustom"
End If
strItem = GetParameter( gvsCommandline, "XML" )
If strItem <> "" Then
With gvoFSO
strItem = .GetAbsolutePathName( strItem )
If .FolderExists( .GetParentFolderName( strItem ) ) Then
gvaSettingsStr.Item( "XML" ) = strItem
End If
End With
End If
strItem = GetParameter( gvsCommandline, "ZOOM" )
If strItem <> "" Then
If IsNumeric( strItem ) Then
If CInt( strItem ) < 50 Then strItem = 50
If CInt( strItem ) > 250 Then strItem = 250
gvaSettingsStr.Item( "ZOOM" ) = CInt( strItem )
End If
End If
strDebug = Align( "<u>Setting:</u>", 21 ) & "<u>Value:</u>" & vbCrLf
For Each strKey In gvaSettingsBool.Keys
strDebug = strDebug & Align( strKey, 14 ) & gvaSettingsBool.Item( strKey ) & vbCrLf
Next
For Each strKey In gvaSettingsStr.Keys
strDebug = strDebug & Align( strKey, 14 ) & """" & gvaSettingsStr.Item( strKey ) & """" & vbCrLf
Next
DebugMessage "Settings After Reading Command Line", strDebug
' Remove HTA path from command line
Set objRE = New RegExp
objRE.IgnoreCase = True
objRE.Pattern = ".*?\.hta."
If objRE.Test( gvsCommandline ) Then
gvsCommandline = Trim( objRE.Replace( gvsCommandline, "" ) )
End If
DisplayCommandLine.innerHTML = gvsCommandline
If gvaSettingsBool.item( "DEVTEST" ) Then
' With /DEVTEST window size is 800x100, zoomfactor 75%
gvaSettingsStr.Item( "ZOOM" ) = 75
InputZoomFactor.value = "75"
' Remove /DEVTEST from display
objRE.Pattern = "/DEVTEST"
If objRE.Test( DisplayCommandLine.innerHTML ) Then
DisplayCommandLine.innerHTML = objRE.Replace( DisplayCommandLine.innerHTML, "" )
End If
objRE.Pattern = "\s+"
DisplayCommandLine.innerHTML = objRE.Replace( DisplayCommandLine.innerHTML, " " )
End If
Set objRE = Nothing
End Sub
Sub ConfigReadDefaults( )
Dim strDebug, strKey
gvaDefaultsBool.Item( "BASIC" ) = False
gvaDefaultsBool.Item( "CHAIN" ) = False
gvaDefaultsBool.Item( "CM" ) = False
gvaDefaultsBool.Item( "COPY" ) = False
gvaDefaultsBool.Item( "DEBUG" ) = False
gvaDefaultsBool.Item( "DEVTEST" ) = False
gvaDefaultsBool.Item( "DMIDECODE" ) = False
gvaDefaultsBool.Item( "DXDIAG" ) = False
gvaDefaultsBool.Item( "KEEPXML" ) = False
gvaDefaultsBool.Item( "NOUPD" ) = False
gvaDefaultsBool.Item( "NOSCORES" ) = False
gvaDefaultsBool.Item( "PRINT" ) = False
gvaDefaultsBool.Item( "USBSTOR" ) = False
gvaDefaultsBool.Item( "VIRTUAL" ) = False
gvaDefaultsStr.Item( "COMPUTER" ) = GetLocalComputerName( )
gvaDefaultsStr.Item( "CUSTOMCOLORS" ) = "white;black;blue;silver;black;black" ' Background;Captions;Links;ButtonFace;ButtonCaption;Code
gvaSettingsStr.Item( "DEBUGLOG" ) = Left( Self.location.pathname, Len( Self.location.pathname ) - 4 ) & ".debuglog.html"
gvaDefaultsStr.Item( "SAVE" ) = ""
gvaDefaultsStr.Item( "TEMPDIR" ) = gvoFSO.GetAbsolutePathName( gvoWSHShell.ExpandEnvironmentStrings( "%Temp%" ) )
gvaDefaultsStr.Item( "THEME" ) = "ThemeBW" ' ThemeBlue, ThemeBW, ThemeCustom, ThemeDark or ThemeRed
gvaDefaultsStr.Item( "XML" ) = Left( Self.location.pathname, Len( Self.location.pathname ) - 4 ) & ".xml"
gvaDefaultsStr.Item( "ZOOM" ) = 100
ConfigSetDefaults
strDebug = Align( "<u>Setting:</u>", 21 ) & "<u>Value:</u>" & vbCrLf
For Each strKey In gvaDefaultsBool.Keys
strDebug = strDebug & Align( strKey, 14 ) & gvaSettingsBool.Item( strKey ) & vbCrLf
Next
For Each strKey In gvaDefaultsStr.Keys
strDebug = strDebug & Align( strKey, 14 ) & """" & gvaSettingsStr.Item( strKey ) & """" & vbCrLf
Next
DebugMessage "Settings After Reading Defaults", strDebug
End Sub
Sub ConfigReadFile( )
Dim intMinSize, intSize
Dim objFile, objRE
Dim strDebug, strConfig, strItem, strKey, strSubItem, strUConfig
If gvoFSO.FileExists( gvsConfigFile ) Then
' Check config file size
Set objFile = gvoFSO.GetFile( gvsConfigFile )
intSize = objFile.Size
Set objFile = Nothing
' Check minimum required file size by "measuring" command line switch length
intMinSize = 9999
For Each strKey In gvaDefaultsBool.Keys
intMinSize = Min( intMinSize, Len( strKey ) )
Next
' Add 1 for the forward slash
intMinSize = intMinSize + 1
' Config file is useless if its size is less than the length of the shortest command line switch
If intSize < intMinSize Then
gvoFSO.DeleteFile gvsConfigFile, True
Else
' Read the entire contents of the configuration file
Set objFile = gvoFSO.OpenTextFile( gvsConfigFile, ForReading, False, TristateFalse )
strConfig = Trim( Replace( objFile.ReadAll( ), vbCrLf, " " ) )
strUConfig = UCase( strConfig )
objFile.Close
Set objFile = Nothing
' Replace all whitespace (space, tab, linefeed, carriage return, or any combination) by single spaces
DisplayConfig.innerHTML = Join( Split( strConfig, vbCrLf ), " " )
DisplayConfig.innerHTML = Join( Split( DisplayConfig.innerHTML, vbCr ), " " )
DisplayConfig.innerHTML = Join( Split( DisplayConfig.innerHTML, vbLf ), " " )
DisplayConfig.innerHTML = Trim( Join( Split( DisplayConfig.innerHTML, vbTab ), " " ) )
' Remove /DEVTEST from display
Set objRE = New RegExp
objRE.Pattern = "/DEVTEST"
objRE.IgnoreCase = True
If objRE.Test( DisplayConfig.innerHTML ) Then
DisplayConfig.innerHTML = objRE.Replace( DisplayConfig.innerHTML, "" )
End If
Set objRE = Nothing
For Each strKey In gvaSettingsBool.Keys
If InStr( strUConfig, "/" & strKey ) Then gvaSettingsBool.Item( strKey ) = True
Next
strItem = GetParameter( strConfig, "THEME" )
Select Case UCase( strItem )
Case "BLUE":
gvaSettingsStr.Item( "THEME" ) = "ThemeBlue"
Case "BW":
gvaSettingsStr.Item( "THEME" ) = "ThemeBW"
Case "CUSTOM":
gvaSettingsStr.Item( "THEME" ) = "ThemeCustom"
Case "DARK":
gvaSettingsStr.Item( "THEME" ) = "ThemeDark"
Case "":
Case "DEFAULT":
gvaSettingsStr.Item( "THEME" ) = "ThemeBW"
Case "RED":
gvaSettingsStr.Item( "THEME" ) = "ThemeRed"
End Select
strSubItem = GetParameter( strConfig, "CUSTOMCOLORS" )
If ( strItem = "" Or gvaSettingsStr.Item( "THEME" ) = "ThemeCustom" ) And strSubItem <> "" Then
gvaSettingsStr.Item( "CUSTOMCOLORS" ) = LCase( strSubItem )
gvaSettingsStr.Item( "THEME" ) = "ThemeCustom"
End If
strItem = GetParameter( strConfig, "XML" )
If strItem <> "" Then
With gvoFSO
If .FolderExists( .GetParentFolderName( .GetAbsolutePathName( strItem ) ) ) Then
gvaSettingsStr.Item( "XML" ) = .GetAbsolutePathName( strItem )
End If
End With
End If
strItem = GetParameter( strConfig, "ZOOM" )
If strItem <> "" Then
If IsNumeric( strItem ) Then
If CInt( strItem ) < 50 Then strItem = 50
If CInt( strItem ) > 250 Then strItem = 250
gvaSettingsStr.Item( "ZOOM" ) = CInt( strItem )
End If
End If
End If
End If
strDebug = Align( "<u>Setting:</u>", 21 ) & "<u>Value:</u>" & vbCrLf
For Each strKey In gvaDefaultsBool.Keys
strDebug = strDebug & Align( strKey, 14 ) & gvaSettingsBool.Item( strKey ) & vbCrLf
Next
For Each strKey In gvaDefaultsStr.Keys
strDebug = strDebug & Align( strKey, 14 ) & """" & gvaSettingsStr.Item( strKey ) & """" & vbCrLf
Next
If gvaSettingsBool.Item( "DEBUG" ) And gvoFSO.FileExists( gvaSettingsStr.Item( "DEBUGLOG" ) ) Then gvoFSO.DeleteFile gvaSettingsStr.Item( "DEBUGLOG" ), True
DebugMessage "Settings After Reading " & gvsConfigFile, strDebug
End Sub
Sub ConfigRemoveFile( )
If gvoFSO.FileExists( gvsConfigFile ) Then gvoFSO.DeleteFile gvsConfigFile, True
End Sub
Sub ConfigReset( )
ConfigRemoveFile
DisplayConfig.innerHTML = ""
ButtonEditCfg.disabled = True
ButtonReset.disabled = True
InputZoomFactor.value = gvaDefaultsStr.Item( "ZOOM" )
ConfigSetDefaults
ConfigUpdateStatus
End Sub
Sub ConfigSaveChanges( )
Dim objItem, objOption, strCustomColors, strDebug, strKey
With gvoFSO
If Not IsEmpty( InputDxDiag.value ) Then
If .FolderExists( .GetParentFolderName( InputDxDiag.value ) ) Then
InputDxDiag.value = .GetAbsolutePathName( InputDxDiag.value )
End If
End If
If Not IsEmpty( InputDebugLogPath.value ) Then
If .FolderExists( .GetParentFolderName( InputDebugLogPath.value ) ) Then
InputDebugLogPath.value = .GetAbsolutePathName( InputDebugLogPath.value )
End If
End If
End With
gvaSettingsBool.Item( "CM" ) = CheckboxCM.checked
gvaSettingsBool.Item( "CHAIN" ) = CheckboxCharacterChains.checked
gvaSettingsBool.Item( "DEBUG" ) = CheckboxDebugMode.checked
gvaSettingsBool.Item( "DMIDECODE" ) = CheckboxDMIDecode.checked
gvaSettingsBool.Item( "DXDIAG" ) = CheckboxDxDiag.checked
gvaSettingsBool.Item( "KEEPXML" ) = CheckboxKeepXML.checked
gvaSettingsBool.Item( "NOUPD" ) = Not CheckboxCheckUpd.checked
gvaSettingsBool.Item( "NOSCORES" ) = Not CheckboxScores.checked
gvaSettingsBool.Item( "USBSTOR" ) = CheckboxUSBSTOR.checked
gvaSettingsBool.Item( "VIRTUAL" ) = CheckboxVirtual.checked
If gvaSettingsStr.Item( "XML" ) <> "" Then
If InputDxDiag.value <> "" Then
gvaSettingsStr.Item( "XML" ) = gvaDefaultsStr.Item( "XML" )
Else
gvaSettingsStr.Item( "XML" ) = InputDxDiag.value
End If
End If
If InputDebugLogPath.value = "" Then
gvaSettingsStr.Item( "DEBUGLOG" ) = gvaDefaultsStr.Item( "DEBUGLOG" )
Else
gvaSettingsStr.Item( "DEBUGLOG" ) = InputDebugLogPath.value
End If
If ThemeBlue.checked Then
gvaSettingsStr.Item( "THEME" ) = "ThemeBlue"
gvaSettingsStr.Item( "CUSTOMCOLORS" ) = "darkblue;white;red;silver;black;yellow"
ElseIf ThemeDark.checked Then
gvaSettingsStr.Item( "THEME" ) = "ThemeDark"
gvaSettingsStr.Item( "CUSTOMCOLORS" ) = "black;white;gold;slategray;snow;red"
ElseIf ThemeBW.checked Then
gvaSettingsStr.Item( "THEME" ) = "ThemeBW"
gvaSettingsStr.Item( "CUSTOMCOLORS" ) = gvaDefaultsStr.Item( "CUSTOMCOLORS" )
ElseIf ThemeRed.checked Then
gvaSettingsStr.Item( "THEME" ) = "ThemeRed"
gvaSettingsStr.Item( "CUSTOMCOLORS" ) = "red;yellow;darkblue;silver;black;white"
ElseIf ThemeCustom.checked Then
For Each objOption In BackgroundColor.options
If objOption.selected Then strCustomColors = objOption.value
Next
For Each objOption In CaptionsColor.options
If objOption.selected Then strCustomColors = strCustomColors & ";" & objOption.value
Next
For Each objOption In LinksColor.options
If objOption.selected Then strCustomColors = strCustomColors & ";" & objOption.value
Next
For Each objOption In ButtonFaceColor.options
If objOption.selected Then strCustomColors = strCustomColors & ";" & objOption.value
Next
For Each objOption In ButtonCaptionsColor.options
If objOption.selected Then strCustomColors = strCustomColors & ";" & objOption.value
Next
For Each objOption In CodeColor.options
If objOption.selected Then strCustomColors = strCustomColors & ";" & objOption.value
Next
gvaSettingsStr.Item( "THEME" ) = "ThemeCustom"
gvaSettingsStr.Item( "CUSTOMCOLORS" ) = LCase( strCustomColors )
End If
If Not InputZoomFactor.value = gvaSettingsStr.Item( "ZOOM" ) Then
If IsEmpty( InputZoomFactor.value ) Then
InputZoomFactor.value = 100
Else
InputZoomFactor.value = Min( 250, Max( 50, InputZoomFactor.value ) )
End If
gvaSettingsStr.Item( "ZOOM" ) = InputZoomFactor.value
document.body.style.zoom = gvaSettingsStr.Item( "ZOOM" ) & "%"
End If
If ConfigTestIfDefault( ) Then
If gvoFSO.FileExists( gvsConfigFile ) Then
strDebug = "Deleting config file"
gvoFSO.DeleteFile gvsConfigFile, True
End If
DebugMessage "Save settings was clicked, but all settings are default", strDebug
ButtonReset.disabled = True
Else
strDebug = Align( "<u>Setting:</u>", 21 ) & "<u>Value:</u>" & vbCrLf
For Each strKey In gvaSettingsBool.Keys
strDebug = strDebug & Align( strKey, 14 ) & gvaSettingsBool.Item( strKey ) & vbCrLf
Next
For Each strKey In gvaSettingsStr.Keys
strDebug = strDebug & Align( strKey, 14 ) & """" & gvaSettingsStr.Item( strKey ) & """" & vbCrLf
Next
DebugMessage "Settings After Saving Changes", strDebug
End If
End Sub
Sub ConfigSaveFile( )
Dim objFile
dim strConfig, strKey
If ConfigTestIfDefault( ) Then
If gvoFSO.FileExists( gvsConfigFile ) Then
gvoFSO.DeleteFile gvsConfigFile, True
MsgBox "Since all settings are back to their default values, """ & gvsConfigFile & """ has been deleted", vbOKOnly, "Save Settings"
Else
MsgBox "Since all settings have their default values, nothing was saved", vbOKOnly, "Save Settings"
End If
Else
strConfig = ""
For Each strKey In gvaSettingsBool.Keys
If gvaSettingsBool.Item( strKey ) Then
strConfig = strConfig & " /" & strKey
End If
Next
If gvaSettingsBool.Item( "DXDIAG" ) And ( gvaSettingsStr.Item( "XML" ) <> "" ) Then
strConfig = strConfig & " /XML:" & gvaSettingsStr.Item( "XML" )
End If
If gvaSettingsStr.Item( "COMPUTER" ) <> "" Then
If UCase( gvaSettingsStr.Item( "COMPUTER" ) ) <> UCase( GetLocalComputerName ) Then
strConfig = strConfig & " /COMPUTER:" & UCase( gvaSettingsStr.Item( "COMPUTER" ) )
End If
End If
If gvaSettingsStr.Item( "THEME" ) <> "" And gvaSettingsStr.Item( "THEME" ) <> "ThemeBW" Then
strConfig = strConfig & " /THEME:" & Mid( gvaSettingsStr.Item( "THEME" ), 6 )
If gvaSettingsStr.Item( "THEME" ) = "ThemeCustom" Then
If gvaSettingsStr.Item( "CUSTOMCOLORS" ) <> "" Then
strConfig = Trim( strConfig & " /CUSTOMCOLORS:" & LCase( gvaSettingsStr.Item( "CUSTOMCOLORS" ) ) )
End If
End If
End If
If Not CInt( gvaSettingsStr.Item( "ZOOM" ) ) = 100 Then
strConfig = strConfig & " /ZOOM:" & gvaSettingsStr.Item( "ZOOM" )
End If
Set objFile = gvoFSO.OpenTextFile( gvsConfigFile, ForWriting, True, TristateFalse )
objFile.Write strConfig
objFile.Close
Set objFile = Nothing
DisplayConfig.innerHTML = strConfig
MsgBox "The new settings have been saved in """ & gvsConfigFile & """", vbOKOnly + vbInformation + vbApplicationModal, "Settings saved"
DebugMessage "Saving Settings to " & gvsConfigFile, strConfig
End If
End Sub
Sub ConfigSetDefaults( )
Dim strKey
For Each strKey In gvaDefaultsBool.Keys
gvaSettingsBool.Item( strKey ) = gvaDefaultsBool.Item( strKey )
Next
For Each strKey In gvaDefaultsStr.Keys
gvaSettingsStr.Item( strKey ) = gvaDefaultsStr.Item( strKey )
Next
End Sub
Function ConfigTestIfDefault( )
Dim blnStart, objChkBx, strTest
' In debug mode (best set on the command line), show a MessageBox with checkbox settings vs defaults
If gvaSettingsBool.Item( "DEBUG" ) Or ( InStr( gvsCommandlineUC, "/DEBUG" ) > 0 ) Then
blnStart = False
strTest = Align( "CHECKBOX", 23 ) & vbTab & Align( "CHECKED", 7 ) & vbTab & "BY DEFAULT" & vbCrLf _
& Align( "=======", 23 ) & vbTab & Align( "======", 7 ) & vbTab & "========" & vbCrLf & vbCrLf
For Each objChkBx In document.getElementsByTagName( "input" )
If objChkBx.type = "checkbox" Then
If InStr( objChkBx.id, "DMIDecode" ) > 0 Then
blnStart = True
End If
If blnStart Then
strTest = strTest & Align( objChkBx.id, 23 ) & vbTab & Align( objChkBx.checked, 20 ) & vbTab
If objChkBx.id = "CheckboxCM" Then strTest = strTest & gvaDefaultsBool.Item( "CM" )
If objChkBx.id = "CheckboxCharacterChains" Then strTest = strTest & gvaDefaultsBool.Item( "CHAIN" )
If objChkBx.id = "CheckboxDebugMode" Then strTest = strTest & gvaDefaultsBool.Item( "DEBUG" )
If objChkBx.id = "CheckboxDMIDecode" Then strTest = strTest & gvaDefaultsBool.Item( "DMIDECODE" )
If objChkBx.id = "CheckboxDxDiag" Then strTest = strTest & gvaDefaultsBool.Item( "DXDIAG" )
If objChkBx.id = "CheckboxKeepXML" Then strTest = strTest & gvaDefaultsBool.Item( "KEEPXML" )
If objChkBx.id = "CheckboxCheckUpd" Then strTest = strTest & Not gvaDefaultsBool.Item( "NOUPD" )
If objChkBx.id = "CheckboxScores" Then strTest = strTest & Not gvaDefaultsBool.Item( "NOSCORES" )
If objChkBx.id = "CheckboxUSBSTOR" Then strTest = strTest & gvaDefaultsBool.Item( "USBSTOR" )
If objChkBx.id = "CheckboxVirtual" Then strTest = strTest & gvaDefaultsBool.Item( "VIRTUAL" )
strTest = strTest & vbCrLf
End If
End if
Next
MsgBox strTest, vbOKOnly, "Debugging Info for ConfigTestIfDefault( )"
End If ' end of debugging code
' Check all checkboxes in Settings screen and compare with defaults
If Not ( CheckboxCM.checked = gvaSettingsBool.Item( "CM" ) ) Then
ConfigTestIfDefault = False
Exit Function
End If
If Not ( CheckboxCharacterChains.checked = gvaDefaultsBool.Item( "CHAIN" ) ) Then
ConfigTestIfDefault = False
Exit Function
End If
If Not ( CheckboxDebugMode.checked = gvaDefaultsBool.Item( "DEBUG" ) ) Then
ConfigTestIfDefault = False
Exit Function
End If
If Not ( CheckboxDMIDecode.checked = gvaDefaultsBool.Item( "DMIDECODE" ) ) Then
ConfigTestIfDefault = False
Exit Function
End If
If Not ( CheckboxDxDiag.checked = gvaDefaultsBool.Item( "DXDIAG" ) ) Then
ConfigTestIfDefault = False
Exit Function
End If
If Not ( CheckboxKeepXML.checked = gvaDefaultsBool.Item( "KEEPXML" ) ) Then
ConfigTestIfDefault = False
Exit Function
End If
If ( CheckboxCheckUpd.checked = gvaDefaultsBool.Item( "NOUPD" ) ) Then
ConfigTestIfDefault = False
Exit Function
End If
If ( CheckboxScores.checked = gvaDefaultsBool.Item( "NOSCORES" ) ) Then
ConfigTestIfDefault = False
Exit Function
End If
If Not ( CheckboxUSBSTOR.checked = gvaDefaultsBool.Item( "USBSTOR" ) ) Then
ConfigTestIfDefault = False
Exit Function
End If
If Not ( CheckboxVirtual.checked = gvaDefaultsBool.Item( "VIRTUAL" ) ) Then
ConfigTestIfDefault = False
Exit Function
End If
If gvaSettingsStr.Item( "THEME" ) = "" Then
gvaSettingsStr.Item( "THEME" ) = gvaDefaultsStr.Item( "THEME" )
gvaSettingsStr.Item( "CUSTOMCOLORS" ) = gvaDefaultsStr.Item( "CUSTOMCOLORS" )
document.getElementById( gvaDefaultsStr.Item( "THEME" ) ).checked = True
End If
If ThemeCustom.checked Or ThemeBlue.checked Or ThemeDark.checked Or ThemeRed.checked Then
ConfigTestIfDefault = False
Exit Function
End If
ConfigTestIfDefault = True
End Function
Sub ConfigUpdateStatus( )
Dim arrCustomColors, colElements, objElement, objOption
If gvaSettingsBool.Item( "BASIC" ) Then
ButtonBasic.value = "Full"
ButtonBasic.accessKey = "f"
Else
ButtonBasic.value = "Basic"
ButtonBasic.accessKey = "b"
End If
ButtonDeleteXML.disabled = Not gvoFSO.FileExists( gvaSettingsStr.Item( "XML" ) )
CheckboxCM.checked = gvaSettingsBool.Item( "CM" )
CheckboxCharacterChains.checked = gvaSettingsBool.Item( "CHAIN" )
CheckboxDebugMode.checked = gvaSettingsBool.Item( "DEBUG" )
CheckDMIDecode
CheckboxDMIDecode.checked = gvaSettingsBool.Item( "DMIDECODE" )
CheckboxDMIDecode.disabled = gvbWinPE
CheckboxDxDiag.checked = gvaSettingsBool.Item( "DXDIAG" ) And Not gvbWinPE
CheckboxDxDiag.disabled = gvbWinPE
CheckboxKeepXML.checked = gvaSettingsBool.Item( "KEEPXML" ) And gvaSettingsBool.Item( "DXDIAG" ) And Not gvbWinPE
CheckboxKeepXML.disabled = gvbWinPE
CheckboxCheckUpd.checked = Not gvaSettingsBool.Item( "NOUPD" )
CheckboxScores.checked = Not gvaSettingsBool.Item( "NOSCORES" )
CheckboxUSBSTOR.checked = gvaSettingsBool.Item( "USBSTOR" )
CheckboxVirtual.checked = gvaSettingsBool.Item( "VIRTUAL" )
ComputerName.value = gvaSettingsStr.Item( "COMPUTER" )
InputDxDiag.value = gvaSettingsStr.Item( "XML" )
InputDxDiag.readonly = Not CheckboxDxDiag.checked Or gvbWinPE
InputDebugLogPath.value = gvaSettingsStr.Item( "DEBUGLOG" )
InputDebugLogPath.disabled = Not gvaSettingsBool.Item( "DEBUG" )
If gvaSettingsStr.Item( "THEME" ) = "" Then
ThemeBW.checked = True
Else
document.getElementById( gvaSettingsStr.Item( "THEME" ) ).checked = True
End If
If ThemeCustom.checked Then
arrCustomColors = Split( gvaSettingsStr.Item( "CUSTOMCOLORS" ), ";" )
For Each objOption In BackgroundColor.options
objOption.selected = ( objOption.value = arrCustomColors(0) )
Next
For Each objOption In CaptionsColor.options
objOption.selected = ( objOption.value = arrCustomColors(1) )
Next
For Each objOption In LinksColor.options
objOption.selected = ( objOption.value = arrCustomColors(2) )
Next
For Each objOption In ButtonFaceColor.options
objOption.selected = ( objOption.value = arrCustomColors(3) )
Next
For Each objOption In ButtonCaptionsColor.options
objOption.selected = ( objOption.value = arrCustomColors(4) )
Next
For Each objOption In CodeColor.options
objOption.selected = ( objOption.value = arrCustomColors(5) )
Next
ElseIf ThemeBlue.checked Then
gvaSettingsStr.Item( "CUSTOMCOLORS" ) = "darkblue;white;red;silver;black;yellow"
arrCustomColors = Split( gvaSettingsStr.Item( "CUSTOMCOLORS" ), ";" )
ElseIf ThemeDark.checked Then
gvaSettingsStr.Item( "CUSTOMCOLORS" ) = "black;white;gold;slategray;snow;red"
arrCustomColors = Split( gvaSettingsStr.Item( "CUSTOMCOLORS" ), ";" )
ElseIf ThemeRed.checked Then
gvaSettingsStr.Item( "CUSTOMCOLORS" ) = "red;yellow;darkblue;silver;black;white"
arrCustomColors = Split( gvaSettingsStr.Item( "CUSTOMCOLORS" ), ";" )
Else
gvaSettingsStr.Item( "CUSTOMCOLORS" ) = gvaDefaultsStr.Item( "CUSTOMCOLORS" )
arrCustomColors = Split( gvaSettingsStr.Item( "CUSTOMCOLORS" ), ";" )
End If
ListColors "BackgroundColor", arrCustomColors(0)
ListColors "CaptionsColor", arrCustomColors(1)
ListColors "LinksColor", arrCustomColors(2)
ListColors "ButtonFaceColor", arrCustomColors(3)
ListColors "ButtonCaptionsColor", arrCustomColors(4)
ListColors "CodeColor", arrCustomColors(5)
SetCustomColor "BackgroundColor"
SetCustomColor "CaptionsColor"
SetCustomColor "LinksColor"
SetCustomColor "ButtonFaceColor"
SetCustomColor "ButtonCaptionsColor"
SetCustomColor "CodeColor"
document.body.style.zoom = gvaSettingsStr.Item( "ZOOM" ) & "%"
EnableWinSATScores
End Sub
Sub CopyToClipboard
On Error Resume Next ' REQUIRED
Document.parentWindow.clipboardData.setData "text", gvsHeader & vbCrLf & gvsCSVTxt & vbCrLf
If Err Then
MsgBox "An error occurred while trying to copy data to the clipboard:" & vbCrLf & vbCrLf & Err.Description, vbOKOnly, "Clipboard Error"
End If
On Error Goto 0
End Sub
Sub CreateDebugLogFile( )
Dim objDebugLog, strHTML
' Header for new debugging log file; note the "refresh" meta tag, allowing dynamic updates of the displayed log
strHTML = "<!DOCTYPE html>" & vbCrLf _
& "<html lang=""en"">" _
& vbCrLf _
& "<head>" _
& vbCrLf _
& "<title>Basic Hardware Inventory Debugging Log " & gvsComputer & "</title>" _
& vbCrLf _
& "<meta http-equiv=""refresh"" content=""5"">" _
& vbCrLf _
& "</head>" _
& vbCrLf _
& "<body>" _
& vbCrLf _
& "<pre>" _
& vbCrLf
' Create the new debugging log file, then close it
Set objDebugLog = gvoFSO.OpenTextFile( gvaSettingsStr.Item( "DEBUGLOG" ), ForWriting, True )
objDebugLog.Write strHTML
objDebugLog.Close
Set objDebugLog = Nothing
' Open the new debugging log file in the default browser (requires .html log file extension)
gvoWSHShell.Run gvaSettingsStr.Item( "DEBUGLOG" ), 7, False
End Sub
Function CreateLine( strProperty )
' This subroutine will split up a string into separate words:
' "SCSILogicalUnit" will be converted to "SCSI Logical Unit"
Dim chrA, chrB, chrC
Dim i, j, k
Dim strCaps, strLowc, strPropDescr
strPropDescr = strProperty
strCaps = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
strLowc = LCase( strCaps )
' Default value, in case something goes wrong
CreateLine = strProperty
i = 0
Do
i = i + 1
j = i + 1
If j >= Len( strPropDescr ) Then Exit Do
chrA = Mid( strPropDescr, i, 1 )
chrB = Mid( strPropDescr, j, 1 )
If InStr( strLowc, chrA ) > 0 And InStr( strCaps, chrB ) > 0 Then
strPropDescr = Left( strPropDescr, i ) & " " & Mid( strPropDescr, j )
i = i + 2
j = i + 1
End If
Loop
If Len( strPropDescr ) > 2 Then
i = 0
Do
i = i + 1
j = i + 1
k = i + 2
If k >= Len( strPropDescr ) Then Exit Do
chrA = Mid( strPropDescr, i, 1 )
chrB = Mid( strPropDescr, j, 1 )
chrC = Mid( strPropDescr, k, 1 )
If InStr( strCaps, chrA ) > 0 And InStr( strCaps, chrB ) > 0 And InStr( strLowc, chrC ) > 0 Then
strPropDescr = Left( strPropDescr, i ) & " " & Mid( strPropDescr, j )
i = i + 3
j = i + 1
k = i + 2
End If
Loop
End If
CreateLine = strPropDescr
End Function
Sub DebugMessage( myTitle, myMessage )
' If Debug Logging is enabled, create or open a debug log file, and append a debugging message
Dim objDebugLog, objRE, strDebugText
On Error Resume Next ' REQUIRED
If gvaSettingsBool.Item( "DEBUG" ) Then
If gvoFSO.FileExists( gvaSettingsStr.Item( "DEBUGLOG" ) ) Then
' Open existing log file and remove closing tags at the end of the HTML content
Set objDebugLog = gvoFSO.OpenTextFile( gvaSettingsStr.Item( "DEBUGLOG" ) )
strDebugText = objDebugLog.ReadAll( )
objDebugLog.Close
Set objRE = New RegExp
objRE.Global = True
objRE.IgnoreCase = True
objRE.Pattern = "</pre>\s*</body>\s*</html>\s*$"
Set objDebugLog = gvoFSO.OpenTextFile( gvaSettingsStr.Item( "DEBUGLOG" ), ForWriting, True )
objDebugLog.Write objRE.Replace( strDebugText, "" )
objDebugLog.Close
Set objDebugLog = Nothing
Else
' Create a new debugging log file and open it in the default browser
CreateDebugLogFile
End If
' Append debugging message to log file
Set objDebugLog = gvoFSO.OpenTextFile( gvaSettingsStr.Item( "DEBUGLOG" ), ForAppending, True )
If ( Trim( myTitle ) = "" ) Then
objDebugLog.WriteLine "[" & TimeStamp( ) & "] " & myMessage
Else
objDebugLog.WriteLine "[" & TimeStamp( ) & "] " & myTitle & vbCrLf & String( Len( myTitle ), "-" ) & vbCrLf & myMessage
End If
' Append closing tags at the end of the HTML content
objDebugLog.WriteLine vbCrLf & vbCrLf & "</pre>" & vbCrLf & "</body>" & vbCrLf & "</html>"
' Close the log file
objDebugLog.Close
Set objDebugLog = Nothing
End If
On Error GoTo 0
End Sub
Sub DeleteDxDiagXML( )
If InputDxDiag.value <> "" Then
On Error Resume Next ' REQUIRED
If gvoFSO.FileExists( InputDxDiag.value ) Then
gvoFSO.DeleteFile InputDxDiag.value, True
End If
If Err Then
MsgBox "Error while trying to delete the existing DxDiag XML file" & vbCrLf & """" & InputDxDiag.value & """", vbOKOnly + vbExclamation + vbApplicationModal, "File Delete Error"
Err.Clear
End If
On Error Goto 0
End If
ButtonDeleteXML.disabled = True
End Sub
Sub DetailsBIOS( )
gvsDetails = HandleClass( "Win32_BIOS", "root/CIMV2" )
If gvaSettingsBool.Item( "DXDIAG" ) Then
gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleXMLValue( "/DxDiag/SystemInformation/BIOS" )
End If
If gvaSettingsBool.Item( "DMIDECODE" ) Then
gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleDMIDetails( "BIOS" )
End If
DetailsWindow "BIOS", gvsDetails
End Sub
Sub DetailsCDROM( )
gvsDetails = HandleClass( "Win32_CDROMDrive", "root/CIMV2" ) & vbCrLf & vbCrLf _
& HandleClass( "Win32_IDEController", "root/CIMV2" ) & vbCrLf & vbCrLf _
& HandleClass( "Win32_SCSIController", "root/CIMV2" ) & vbCrLf & vbCrLf _
& HandleClass( "Win32_IDEControllerDevice", "root/CIMV2" ) & vbCrLf & vbCrLf _
& HandleClass( "Win32_SCSIControllerDevice", "root/CIMV2" )
If gvaSettingsBool.Item( "DXDIAG" ) Then
gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleXMLNode( "/DxDiag/LogicalDisks/LogicalDisk[HardDriveIndex = 0 and FileSystem <= """"]" )
End If
DetailsWindow "CD/DVD-ROM Drives and Controllers", gvsDetails
End Sub
Sub DetailsCPU( )
gvsDetails = HandleClass( "Win32_Processor", "root/CIMV2" ) & vbCrLf & vbCrLf _
& HandleClass( "Win32_WinSAT", "root/CIMV2" )
If gvaSettingsBool.Item( "DXDIAG" ) Then
gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleXMLValue( "/DxDiag/SystemInformation/Processor" )
End If
If gvaSettingsBool.Item( "DMIDECODE" ) Then
gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleDMIDetails( "Processor" )
gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleDMIDetails( "Cache" )
End If
DetailsWindow "CPU", gvsDetails
End Sub
Sub DetailsFDD( )
On Error Resume Next ' REQUIRED
gvsDetails = HandleClass( "MSFT_Volume", "root/Microsoft/Windows/Storage" ) & vbCrLf & vbCrLf _
& HandleClass( "Win32_LogicalDisk", "root/CIMV2" ) & vbCrLf & vbCrLf _
& HandleClass( "Win32_PortConnector", "root/CIMV2" )
DetailsWindow "Floppy Disk Drives and Connectors", gvsDetails
On Error GoTo 0
End Sub
Sub DetailsHDD( )
Dim objRE
Set objRE = New RegExp
objRE.Global = True
objRE.Pattern = vbcrlf & "+"
Set objRE = Nothing
On Error Resume Next ' REQUIRED
gvsDetails = HandleClass( "MSFT_PhysicalDisk", "root/Microsoft/Windows/Storage" ) & vbCrLf & vbCrLf _
& HandleClass( "MSFT_Volume", "root/Microsoft/Windows/Storage" ) & vbCrLf & vbCrLf _
& HandleClass( "Win32_DiskDrive", "root/CIMV2" ) & vbCrLf & vbCrLf _
& HandleClass( "Win32_LogicalDiskToPartition", "root/CIMV2" ) & vbCrLf & vbCrLf _
& HandleClass( "Win32_IDEController", "root/CIMV2" ) & vbCrLf & vbCrLf _
& HandleClass( "Win32_SCSIController", "root/CIMV2" ) & vbCrLf & vbCrLf _
& HandleClass( "Win32_IDEControllerDevice", "root/CIMV2" ) & vbCrLf & vbCrLf _
& HandleClass( "Win32_SCSIControllerDevice", "root/CIMV2" ) & vbCrLf & vbCrLf _
& HandleClass( "Win32_WinSAT", "root/CIMV2" )
If gvaSettingsBool.Item( "DXDIAG" ) Then
gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleXMLNode( "/DxDiag/LogicalDisks/LogicalDisk[Model > """" and FileSystem > """"]" )
End If
DetailsWindow "Disk Drives and Controllers", gvsDetails
On Error Goto 0
End Sub
Sub DetailsKeyboard( )
On Error Resume Next ' REQUIRED
gvsDetails = HandleClass( "Win32_Keyboard", "root/CIMV2" ) & vbCrLf & vbCrLf _
& HandleClass( "MSKeyboard_PortInformation", "root/WMI" )
If gvaSettingsBool.Item( "DXDIAG" ) Then
gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleXMLNode( "/DxDiag/DirectInput" )
End If
DetailsWindow "Keyboard", gvsDetails
On Error Goto 0
End Sub
Sub DetailsMainBoard( )
gvsDetails = HandleClass( "Win32_BaseBoard", "root/CIMV2" ) & vbCrLf & vbCrLf _
& HandleClass( "Win32_SystemEnclosure", "root/CIMV2" ) & vbCrLf & vbCrLf _
& HandleClass( "Win32_WinSAT", "root/CIMV2" )
If gvaSettingsBool.Item( "DMIDECODE" ) Then
gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleDMIDetails( "Baseboard" )
gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleDMIDetails( "System" )
gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleDMIDetails( "Chassis" )
End If
DetailsWindow "Main Board and Chassis", gvsDetails
End Sub
Sub DetailsMemory( )
gvsDetails = HandleClass( "Win32_PhysicalMemoryArray", "root/CIMV2" ) & vbCrLf & vbCrLf _
& HandleClass( "Win32_PhysicalMemory", "root/CIMV2" ) & vbCrLf & vbCrLf _
& HandleClass( "Win32_WinSAT", "root/CIMV2" )
If gvaSettingsBool.Item( "DXDIAG" ) Then
gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleXMLValue( "/DxDiag/SystemInformation/Memory" )
End If
If gvaSettingsBool.Item( "DMIDECODE" ) Then
gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleDMIDetails( "Memory" )
End If
DetailsWindow "Memory", gvsDetails
End Sub
Sub DetailsMonitor( )
On Error Resume Next ' REQUIRED
gvsDetails = HandleClass( "Win32_DesktopMonitor", "root/CIMV2" ) & vbCrLf & vbCrLf _
& HandleClass( "WmiMonitorBasicDisplayParams", "root/WMI" ) & vbCrLf & vbCrLf _
& HandleClass( "WmiMonitorID", "root/WMI" ) & vbCrLf & vbCrLf _
& "<h2>\\" & gvsComputer & "\root\default:StdRegProv</h2>" & vbcrlf & vbcrlf _
& "<h3>HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Enum\DISPLAY</h3>" & vbCrLf & vbCrLf _
& HandleRegEnum( HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Enum\DISPLAY", 1 )
DetailsWindow "Monitors", gvsDetails
On Error Goto 0
End Sub
Sub DetailsMouse( )
On Error Resume Next ' REQUIRED
gvsDetails = HandleClass( "Win32_PointingDevice", "root/CIMV2" ) & vbCrLf & vbCrLf _
& HandleClass( "MSMouse_PortInformation", "root/WMI" )
If gvaSettingsBool.Item( "DXDIAG" ) Then
gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleXMLNode( "/DxDiag/DirectInput" )
End If
DetailsWindow "Mouse", gvsDetails
On Error Goto 0
End Sub
Sub DetailsNIC( )
On Error Resume Next ' REQUIRED
gvsDetails = HandleClass( "MSFT_NetAdapter", "root/StandardCimv2" ) & vbCrLf & vbCrLf _
& HandleClass( "MSFT_NetAdapterAdvancedPropertySettingData", "root/StandardCimv2" ) & vbCrLf & vbCrLf _
& HandleClass( "Win32_NetworkAdapter", "root/CIMV2" ) & vbCrLf & vbCrLf _
& HandleClass( "MSNdis_LinkSpeed", "root/WMI" ) & vbCrLf & vbCrLf _
& HandleClass( "MSNdis_PhysicalMediumType", "root/WMI" )
DetailsWindow "Network Adapter", gvsDetails
On Error Goto 0
End Sub
Sub DetailsPorts( )
gvsDetails = HandleClass( "Win32_ParallelPort", "root/CIMV2" ) & vbCrLf & vbCrLf _
& HandleClass( "Win32_SerialPort", "root/CIMV2" ) & vbCrLf & vbCrLf _
& HandleClass( "Win32_SerialPortConfiguration", "root/CIMV2" ) & vbCrLf & vbCrLf _
& HandleClass( "Win32_USBController", "root/CIMV2" ) & vbCrLf & vbCrLf _
& HandleClass( "Win32_1394ControllerDevice", "root/CIMV2" ) & vbCrLf & vbCrLf _
& HandleClass( "Win32_SystemSlot", "root/CIMV2" ) & vbCrLf & vbCrLf _
& HandleClass( "Win32_PortConnector", "root/CIMV2" )
If gvaSettingsBool.Item( "DXDIAG" ) Then
gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleXMLNode( "/DxDiag/SystemDevices/SystemDevice" )
End If
If gvaSettingsBool.Item( "DMIDECODE" ) Then
gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleDMIDetails( "Slot" )
gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleDMIDetails( "Connector" )
End If
DetailsWindow "Ports and Slots", gvsDetails
End Sub
Sub DetailsSound( )
gvsDetails = HandleClass( "Win32_SoundDevice", "root/CIMV2" )
gvsDetails = gvsDetails & HandleRegEnum( HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Enum\HDAUDIO", True )
If gvaSettingsBool.Item( "DXDIAG" ) Then
gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleXMLNode( "/DxDiag/DirectSound/SoundDevices/SoundDevice" )
End If
DetailsWindow "Sound Devices", gvsDetails
End Sub
Sub DetailsVideo( )
Dim arrSubKeys, i, intResult, objReg, strKey
gvsDetails = HandleClass( "Win32_VideoController", "root/CIMV2" ) & vbCrLf & vbCrLf _
& HandleClass( "CIM_VideoControllerResolution", "root/CIMV2" ) & vbCrLf & vbCrLf _
& HandleClass( "Win32_WinSAT", "root/CIMV2" )
Set objReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!//" & gvsComputer & "/root/default:StdRegProv" )
strKey = "SYSTEM\CurrentControlSet\Control\Class\{4d36e968-e325-11ce-bfc1-08002be10318}"
intResult = objReg.EnumKey( HKEY_LOCAL_MACHINE, strKey, arrSubKeys )
If intResult = 0 Then
For i = 0 To UBound( arrSubKeys )
If IsNumeric( arrSubKeys(i) ) Then
gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleRegEnum( HKEY_LOCAL_MACHINE, strKey & "\" & arrSubKeys(i), 0 )
End If
Next
End If
Set objReg = Nothing
If gvaSettingsBool.Item( "DXDIAG" ) Then
gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleXMLNode( "/DxDiag/DisplayDevices/DisplayDevice" )
End If
DetailsWindow "Display Adapters", gvsDetails
End Sub
Sub DetailsWindow( strCategory, gvsDetails )
Dim objDetailsFile, strHTMLBody, strHTMLFoot, strHTMLHead
strHTMLHead = "<html><head><title>" & strCategory & " details for " & gvsComputer & "</title></head><body>"
strHTMLBody = "<h1 style=""text-align: center;"">" & strCategory & " details for " & gvsComputer & "</h1> <pre style=""font-family: courier,monospace"">" & gvsDetails & "</pre>"
strHTMLFoot = "</body></html>"
' Create a temporary HTML file and open it in the default browser
Set objDetailsFile = gvoFSO.CreateTextFile( gvsDetailsFile )
objDetailsFile.Write( strHTMLHead )
objDetailsFile.Write( strHTMLBody )
objDetailsFile.Write( strHTMLFoot )
objDetailsFile.Close
Set objDetailsFile = Nothing
gvoWSHShell.Run gvsDetailsFile, , False
End Sub
Sub EditSettings( )
gvoWSHShell.Run "notepad.exe """ & gvsConfigFile & """", 1, True
ConfigReadFile
ConfigUpdateStatus
End Sub
Sub EnableWinSATScores( )
Dim objItem
' Hide WinSAT Score fields if not applicable
For Each objItem In document.all
If objItem.className = "Scores" Then
If gvaSettingsBool.Item( "NOSCORES" ) Or gvbWinPE Then
objItem.style.display = "none"
objItem.style.visibility = "collapse"
Else
objItem.style.display = "table-cell"
objItem.style.visibility = "visible"
End If
End If
Next
End Sub
Function GetBusType( myInt )
Dim arrBusTypes, strBusType
strBusType = "Unknown"
arrBusTypes = Split( "Unknown;SCSI;ATAPI;ATA;1394;SSA;Fibre Channel;USB;RAID;iSCSI;SAS;SATA;SD;MMC;Virtual;File Backed Virtual;Storage Spaces;NVMe;Microsoft Reserved", ";" )
If IsNumeric( myInt ) Then
If CInt( myint ) >= 0 And CInt( myInt ) <= UBound( arrBusTypes ) Then
strBusType = arrBusTypes( CInt( myInt ) )
End If
End If
GetBusType = strBusType
End Function
Function GetChassis( )
' Based on a script by Guy Thomas http://computerperformance.co.uk/
Dim colChassis, objChassis, strChassis
Set colChassis = gvoWMIrootCimv2.ExecQuery( "Select ChassisTypes from Win32_SystemEnclosure" )
For Each objChassis in colChassis
Select Case objChassis.ChassisTypes(0) ' ChassisTypes is returned as an array of integers
Case 1:
strChassis = "Maybe Virtual Machine"
Case 2:
strChassis = "Unknown"
Case 3:
strChassis = "Desktop"
Case 4:
strChassis = "Thin Desktop"
Case 5:
strChassis = "Pizza Box"
Case 6:
strChassis = "Mini Tower"
Case 7:
strChassis = "Full Tower"
Case 8:
strChassis = "Portable"
Case 9:
strChassis = "Laptop"
Case 10:
strChassis = "Notebook"
Case 11:
strChassis = "Hand Held"
Case 12:
strChassis = "Docking Station"
Case 13:
strChassis = "All in One"
Case 14:
strChassis = "Sub Notebook"
Case 15:
strChassis = "Space-Saving"
Case 16:
strChassis = "Lunch Box"
Case 17:
strChassis = "Main System Chassis"
Case 18:
strChassis = "Lunch Box"
Case 19:
strChassis = "SubChassis"
Case 20:
strChassis = "Bus Expansion Chassis"
Case 21:
strChassis = "Peripheral Chassis"
Case 22:
strChassis = "Storage Chassis"
Case 23:
strChassis = "Rack Mount Unit"
Case 24:
strChassis = "Sealed-Case PC"
Case Else:
strChassis = "Unknown"
End Select
Next
GetChassis = strChassis
End Function
Sub GetDefaultBrowser( )
Dim strProgID, wshShell
' Get default browser name
strProgID = gvoWSHShell.RegRead( "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\FileExts\.html\UserChoice\ProgID" )
If InStr( strProgID, "-" ) Then
gvsDefaultBrowserName = Left( strProgID, InStr( strProgID, "-" ) - 1 )
Else
gvsDefaultBrowserName = strProgID
End If
If Right( gvsDefaultBrowserName, 4 ) = "HTML" Then gvsDefaultBrowserName = Left( gvsDefaultBrowserName, Len( gvsDefaultBrowserName ) - 4 )
If Right( gvsDefaultBrowserName, 3 ) = "HTM" Then gvsDefaultBrowserName = Left( gvsDefaultBrowserName, Len( gvsDefaultBrowserName ) - 3 )
If Right( gvsDefaultBrowserName, 3 ) = "URL" Then gvsDefaultBrowserName = Left( gvsDefaultBrowserName, Len( gvsDefaultBrowserName ) - 3 )
DebugMessage "", "Default browser name = """ & gvsDefaultBrowserName & """"
' Get default browser path
gvsDefaultBrowserPath = gvoWSHShell.RegRead( "HKEY_CLASSES_ROOT\" & strProgID & "\shell\open\command\" )
If Left( gvsDefaultBrowserPath, 1 ) = """" Then
gvsDefaultBrowserPath = Replace( Left( gvsDefaultBrowserPath, InStr( 2, gvsDefaultBrowserPath, """" ) ), """", "" )
ElseIf Not gvsDefaultBrowserPath = "" And Not gvsDefaultBrowserPath = Null Then
gvsDefaultBrowserPath = Left( gvsDefaultBrowserPath, InStr( gvsDefaultBrowserPath, " " ) - 1 )
End If
DebugMessage "", "Default browser path = """ & gvsDefaultBrowserPath & """"
End Sub
Function GetHostName( myComputer )
' This function uses a stripped version of my Hostname.cmd (version 3) batch file to get
' the hostname for the specified computer without requiring WMI access to that computer.
Dim objBatFile, objDatFile, strBatFile, strDatFile, strHostName
strHostName = myComputer
strBatFile = gvoWSHShell.ExpandEnvironmentStrings( "%Temp%.\~hostname.bat" )
strDatFile = strBatFile & ".dat"
With gvoFSO
If .FileExists( strBatFile ) Then .DeleteFile strBatFile
If .FileExists( strDatFile ) Then .DeleteFile strDatFile
Set objBatFile = .OpenTextFile( strBatFile, ForWriting, True, TristateFalse )
objBatFile.WriteLine "@ECHO OFF"
objBatFile.WriteLine "SETLOCAL ENABLEDELAYEDEXPANSION"
objBatFile.WriteLine "ECHO ""%~1"" | FIND.EXE "":"" >NUL && SET IPv4=|| SET IPv4=-4"
objBatFile.WriteLine "PING.EXE -a %1 %IPv4% -n 1 -w 100 | FIND.EXE ""["" >NUL && FOR /F ""tokens=2 delims=[]"" %%A IN ('PING.EXE -a %1 %IPv4% -n 1 -w 100 ^| FIND.EXE ""[""') DO FOR /F ""tokens=1,2 delims=[]"" %%B IN ('PING.EXE -a %%A %IPv4% -n 1 -w 100 ^| FIND.EXE ""[""') DO (FOR %%D IN (%%B) DO SET HostName=%%D)& FOR /F ""delims=."" %%E IN (""!HostName!"") DO (>""%~f0.dat"" ECHO.%%E)"
objBatFile.WriteLine "ENDLOCAL"
objBatFile.Close
Set objBatFile = Nothing
gvoWSHShell.Run strBatFile & " " & strHostName, 7, True
Sleep 1
.DeleteFile strBatFile
Set objDatFile = .OpenTextFile( strDatFile, ForReading, False, TristateFalse )
strHostName = objDatFile.ReadLine( )
objDatFile.Close
Set objDatFile = Nothing
.DeleteFile strDatFile
End With
GetHostName = strHostName
End Function
Function GetLocalComputerName( )
If gvbWinPE Then
GetLocalComputerName = GetLocalComputerNameWinPE( )
Else
GetLocalComputerName = UCase( gvoWSHShell.ExpandEnvironmentStrings( "%ComputerName%" ) )
End If
End Function
Function GetLocalComputerNameWinPE( )
' Find computer name in WinPE
' Based on code by Richie Schuster
' http://www.sccmog.com/get-current-old-machine-name-winpe-vbscript/
' Caveat: In case of a multi-boot system with multiple computer names, the script
' only returns the computer name of the last Windows installation it finds
Dim colItems, objItem, objWMIService
GetLocalComputerNameWinPE = "localhost"
On Error Resume Next ' REQUIRED
' Find the Windows drive
If gvsWinDrive = "" Then
Set objWMIService = GetObject( "winmgmts://./root/CIMV2" )
Set colItems = objWMIService.ExecQuery ( "SELECT * FROM Win32_LogicalDisk" )
For Each objItem in colItems
If gvoFSO.FolderExists( gvoFSO.BuildPath( objItem.DeviceID, "Windows\System32" ) ) Then
gvsWinDrive = objItem.DeviceID
End If
Next
End If
If gvsWinDrive <> "" Then
' Mount registry hive from Windows drive
gvoWSHShell.Run "CMD.EXE /C REG.EXE Load HKLM\TempHive " & gvsWinDrive & "\windows\system32\config\system", 0, True
' Read computer name from mounted registry hive
GetLocalComputerNameWinPE = UCase( gvoWSHShell.RegRead( "HKEY_LOCAL_MACHINE\TempHive\ControlSet001\Control\ComputerName\ComputerName\ComputerName" ) )
' Unmount registry hive from Windows drive
gvoWSHShell.Run "CMD.EXE /C REG.EXE Load HKLM\TempHive", 0, True
End If
Set colItems = Nothing
Set objWMIService = Nothing
On Error Goto 0
End Function
Function GetMediaType( mtnumber )
Dim strMediaTypeDescription
strMediaTypeDescription = "Unknown"
Select Case mtnumber
Case 1:
strMediaTypeDescription = "5.25 Inch Floppy Disk 1.2 MB"
Case 2:
strMediaTypeDescription = "3.5 Inch Floppy Disk 1.44 MB"
Case 3:
strMediaTypeDescription = "3.5 Inch Floppy Disk 2.88 MB"
Case 4:
strMediaTypeDescription = "3.5 Inch Floppy Disk 20.8 MB"
Case 5:
strMediaTypeDescription = "3.5 Inch Floppy Disk 720 KB"
Case 6:
strMediaTypeDescription = "5.25 Inch Floppy Disk 360 KB"
Case 7:
strMediaTypeDescription = "5.25 Inch Floppy Disk 320 KB"
Case 8:
strMediaTypeDescription = "5.25 Inch Floppy Disk 320 KB"
Case 9:
strMediaTypeDescription = "5.25 Inch Floppy Disk 180 KB"
Case 10:
strMediaTypeDescription = "5.25 Inch Floppy Disk 160 KB"
Case 11:
strMediaTypeDescription = "Removable media other than floppy"
Case 12:
strMediaTypeDescription = "Fixed hard disk media"
Case 13:
strMediaTypeDescription = "3.5 Inch Floppy Disk 120 MB"
Case 14:
strMediaTypeDescription = "3.5 Inch Floppy Disk 640 KB"
Case 15:
strMediaTypeDescription = "5.25 Inch Floppy Disk 640 KB"
Case 16:
strMediaTypeDescription = "5.25 Inch Floppy Disk 720 KB"
Case 17:
strMediaTypeDescription = "3.5 Inch Floppy Disk 1.2 MB"
Case 18:
strMediaTypeDescription = "3.5 Inch Floppy Disk 1.23 MB"
Case 19:
strMediaTypeDescription = "5.25 Inch Floppy Disk 1.23 MB"
Case 20:
strMediaTypeDescription = "3.5 Inch Floppy Disk 128 MB"
Case 21:
strMediaTypeDescription = "3.5 Inch Floppy Disk 230 MB"
Case 22:
strMediaTypeDescription = "8 Inch Floppy Disk 256 KB"
Case Else:
strMediaTypeDescription = "Unknown"
End Select
GetMediaType = strMediaTypeDescription
End Function
Function GetMemoryFormFactor( )
Dim colItems, objItem, objWMIService, intFormFactor, strFormFactor, strQuery
intFormFactor = 0
strFormFactor = ""
strQuery = "SELECT FormFactor FROM Win32_PhysicalMemory"
Set objWMIService = GetObject( "winmgmts://" & gvsComputer & "/root/CIMV2" )
Set colItems = objWMIService.ExecQuery( strQuery )
If Not Err Then
For Each objItem In colItems
intFormFactor = CInt( objItem.FormFactor )
Next
End If
Select Case intFormFactor
Case 0:
strFormFactor = "Unknown"
Case 1:
strFormFactor = "Other"
Case 2:
strFormFactor = "SIP"
Case 3:
strFormFactor = "DIP"
Case 4:
strFormFactor = "ZIP"
Case 5:
strFormFactor = "SOJ"
Case 6:
strFormFactor = "Proprietary"
Case 7:
strFormFactor = "SIMM"
Case 8:
strFormFactor = "DIMM"
Case 9:
strFormFactor = "TSOP"
Case 10:
strFormFactor = "PGA"
Case 11:
strFormFactor = "RIMM"
Case 12:
strFormFactor = "SODIMM"
Case 13:
strFormFactor = "SRIMM"
Case 14:
strFormFactor = "SMD"
Case 15:
strFormFactor = "SSMP"
Case 16:
strFormFactor = "QFP"
Case 17:
strFormFactor = "TQFP"
Case 18:
strFormFactor = "SOIC"
Case 19:
strFormFactor = "LCC"
Case 20:
strFormFactor = "PLCC"
Case 21:
strFormFactor = "BGA"
Case 22:
strFormFactor = "FPBGA"
Case 23:
strFormFactor = "LGA"
Case Else:
strFormFactor = "Unknown"
End Select
GetMemoryFormFactor = strFormFactor
End Function
Function GetOSVer( )
Dim arrOS, colItems, objItem, objWMIService
GetOSVer = 0
Set objWMIService = GetObject( "winmgmts://./root/CIMV2" )
Set colItems = objWMIService.ExecQuery( "SELECT Version FROM Win32_OperatingSystem" )
If Not Err Then
For Each objItem In colItems
arrOS = Split( objItem.Version, "." )
If UBound( arrOS ) > 1 Then
GetOSVer = arrOS(0) & "." & arrOS(1)
Else
GetOSVer = arrOS(0)
End If
Next
End If
Set colItems = Nothing
Set objWMIService = Nothing
End Function
Function GetParameter( myString, myParameter )
' Extract switch value from command line,
' e.g. GetParameter( "/CM /SIZE:1024x768 /NOUPD", "SIZE" ) to extract "1024x768"
Dim strItem, strParameter, strString
' Default return value is an empty string
strParameter = UCase( myParameter )
myString = Trim( myString )
strString = UCase( myString )
If InStr( strString, "/" & strParameter & ":" ) Then
' Step 1: extract switch and everything following it, e.g. "/SIZE:1024x768 /NOUPD"
strItem = Mid( myString, InStr( strString, "/" & strParameter & ":" ) )
' Check if there is anything following the switch and colon
If Len( strItem ) > Len( "/" & strParameter & ":" ) Then
' Step 2: remove the switch name and colon, e.g. in our example this leaves us with "1024x768 /NOUPD"
strItem = Mid( strItem, Len( "/" & strParameter & ":" ) + 1 )
' Check again if there is anything left to parse
If Len( strItem ) > 1 Then
' Check if the value starts with a doublequote
If Left( strItem, 1 ) = """" Then
' Remove the opening doublequote
strItem = Mid( strItem, 2 )
' Remove the closing doublequote and everything after it
strItem = Left( strItem, InStr( strItem, """" ) - 1 )
Else
' If not in doublequotes, remove the first space and everything following it,
' e.g. in our example this leaves us with "1024x768"
If InStr( strItem, " " ) Then strItem = Left( strItem, InStr( strItem, " " ) - 1 )
End If
' Return the result
GetParameter = Trim( strItem )
End If
End If
End If
End Function
Function GetRandomString( myLength )
Dim i, intChar, strResult
strResult = ""
For i = 1 To myLength
intChar = gvoRandom.Next_2( 48, 83 )
If intChar > 57 Then intChar = intChar + 7 ' numbers and captital letters only
strResult = strResult & Chr( intChar )
Next
GetRandomString = strResult
End Function
Function GetVideoRAM( myVideoCard )
' UInt32 cannot handle 4GB and greater, so we'll have to look it up in the registry
' Based on PowerShell code by "farag" at
' https://superuser.com/questions/1461858/fetch-correct-vram-for-gpu-via-command-line-on-windows/1497378#1497378
' Corrected for remote computers AND for multiple video controllers AND for both integrated and discrete video controllers by Steve Robertson
Dim arrSubKeys
Dim binVidMem
Dim i, intRegKeyCount, lngVidMem
Dim objReg
Dim strAdapterName, strRegKey, strSubKey, strVidMem
lngVidMem = 0
strRegKey = "SYSTEM\CurrentControlSet\Control\Class\{4d36e968-e325-11ce-bfc1-08002be10318}"
Set objReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!//" & gvaSettingsStr.Item( "COMPUTER" ) & "/root/default:StdRegProv" )
If objReg.EnumKey( HKEY_LOCAL_MACHINE, strRegKey, arrSubKeys ) = 0 Then
For intRegKeyCount = 0 To UBound( arrSubKeys )
If IsNumeric( arrSubKeys( intRegKeyCount ) ) Then
strSubKey = strRegKey & "\" & Right( "0000" & intRegKeyCount, 4 )
If objReg.GetStringValue( HKEY_LOCAL_MACHINE, strSubKey, "DriverDesc", strAdapterName ) = 0 Then
If strAdapterName = myVideoCard Then
' If a value is specified for HardwareInformation.qwMemorySize, the memory size is 4GB or more and we can ignore HardwareInformation.MemorySize
If objReg.GetQWORDValue( HKEY_LOCAL_MACHINE, strSubKey, "HardwareInformation.qwMemorySize", lngVidMem ) = 0 Then
' lngVidMem contains the amount of video RAM in bytes
ElseIf objReg.GetDWORDValue( HKEY_LOCAL_MACHINE, strSubKey, "HardwareInformation.MemorySize", lngVidMem ) = 0 Then
' lngVidMem contains the amount of video RAM in bytes
ElseIf objReg.GetBinaryValue( HKEY_LOCAL_MACHINE, strSubKey, "HardwareInformation.MemorySize", binVidMem ) = 0 Then
' binVidMem contains the amount of video RAM in MB and specified in a binary array
strVidMem = ""
For i = 0 To UBound( binVidMem )
strVidMem = strVidMem & binVidMem( i )
Next
lngVidMem = Int( strVidMem ) * MB
Else
lngVidMem = 0
End If
End If
End If
End If
Next
Else
Exit Function
End If
Set objReg = Nothing
GetVideoRAM = Round( lngVidMem / MB )
End Function
Function HandleClass( myClass, myNameSpace )
' This subroutine lists all properties and their values for a specified class.
' Created using an example from a Microsoft TechNet ScriptCenter article:
' http://www.microsoft.com/technet/scriptcenter/resources/guiguy/default.mspx
Dim blnNumChain, colItems, intChar, intPadding, intTest, objClass, objItem, objProperty, objWMIService2, strPadding, strProperties
On Error Resume Next ' REQUIRED
strProperties = "<h2>\\" & gvsComputer & "\" & Replace( myNameSpace, "/", "\" ) & ":" & myClass & "</h2>" & vbCrLf & vbCrLf
If LCase( myNameSpace ) = "root/cimv2" Then
Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM " & myClass )
Set objClass = gvoWMIrootCimv2.Get( myClass )
If Err Then
HandleClass = strProperties & "<p>Error while trying to query \\" & gvsComputer & "\root\CIMV2\" & myClass & "</p>" & vbCrLf & vbCrLf
Exit Function
End If
ElseIf LCase( myNameSpace ) = "root/wmi" Then
Set colItems = gvoWMIrootWMI.ExecQuery( "SELECT * FROM " & myClass )
Set objClass = gvoWMIrootWMI.Get( myClass )
If Err Then
HandleClass = strProperties & "<p>Error while trying to query \\" & gvsComputer & "\root\WMI\" & myClass & "</p>" & vbCrLf & vbCrLf
Exit Function
End If
ElseIf LCase( myNameSpace ) = "root/standardcimv2" Then
Set colItems = gvoWMIrootStandardCimv2.ExecQuery( "SELECT * FROM " & myClass )
Set objClass = gvoWMIrootStandardCimv2.Get( myClass )
If Err Then
HandleClass = strProperties & "<p>Error while trying to query \\" & gvsComputer & "\root\StandardCimv2\" & myClass & "</p>" & vbCrLf & vbCrLf
Exit Function
End If
Else
Set objWMIService2 = GetObject( "winmgmts://" & gvsComputer & "/" & myNameSpace )
If Err Then
HandleClass = strProperties & "<p>Error while trying to connect to \\" & gvsComputer & "\" & Replace( myNameSpace, "/", "\" ) & "</p>" & vbCrLf & vbCrLf
Exit Function
End If
Set colItems = objWMIService2.ExecQuery( "SELECT * FROM " & myClass )
Set objClass = objWMIService2.Get( myClass )
If Err Then
HandleClass = strProperties & "<p>Error while trying to query \\" & gvsComputer & "\" & Replace( myNameSpace, "/", "\" ) & "\" & myClass & "</p>" & vbCrLf & vbCrLf
Exit Function
End If
End If
Select Case colItems.Count
Case 0
strProperties = strProperties & "<p>No instances.</p>" & vbCrLf & vbCrLf
Case 1
strProperties = strProperties & "<p>1 instance:</p>" & vbCrLf & vbCrLf
Case Else
strProperties = strProperties & "<p>" & colItems.Count & " instances:</p>" & vbCrLf & vbCrLf
End Select
For Each objItem In colItems
intPadding = 1
For Each objProperty In objClass.Properties_
intPadding = Max( intPadding, Len( CreateLine( objProperty.Name ) ) )
Next
strpadding = Space( intPadding )
For Each objProperty In objClass.Properties_
If objProperty.IsArray = True Then
blnNumChain = True
intTest = 0
For Each intChar In Eval( "objItem." & objProperty.Name )
If IsNumeric( intChar ) Then
intTest = intTest + intChar
Else
blnNumChain = False
Exit For
End If
Next
If blnNumChain And gvaSettingsBool.Item( "CHAIN" ) And ( intTest > 0 ) And ( InStr( objProperty.Name, "Characteristic" ) < 1 ) And ( InStr( objProperty.Name, "Capabilit" ) < 1 ) Then
strProperties = strProperties & Left( CreateLine( objProperty.Name & " (array)" ) & strPadding, intPadding ) & " : " & Eval( "Join( objItem." & objProperty.Name & ", "","" )" ) & vbCrLf
strProperties = strProperties & Left( CreateLine( objProperty.Name & " (string)" ) & strPadding, intPadding ) & " : " & Eval( "Chain( objItem." & objProperty.Name & " )" ) & vbCrLf
Else
strProperties = strProperties & Left( CreateLine( objProperty.Name ) & strPadding, intPadding ) & " : " & Eval( "Join( objItem." & objProperty.Name & ", "","" )" ) & vbCrLf
End If
Else
If IsDate( Eval( "objItem." & objProperty.Name ) ) Then
strProperties = strProperties & Left( CreateLine( objProperty.Name ) & strPadding, intPadding ) & " : " & FormatDateTime( Eval( "objItem." & objProperty.Name ) ) & vbCrLf
Else
strProperties = strProperties & Left( CreateLine( objProperty.Name ) & strPadding, intPadding ) & " : " & Eval( "objItem." & objProperty.Name ) & vbCrLf
End If
End If
Next
strProperties = strProperties & vbCrLf & vbCrLf
Next
Set objWMIService2 = Nothing
On Error Goto 0
HandleClass = strProperties
End Function
Function HandleDMIDetails( myType )
Dim objCMD, strMsg, strOutput
HandleDMIDetails = ""
If gvbWinPE Then Exit Function
On Error Resume Next ' REQUIRED
Set objCMD = gvoWSHShell.Exec( "CMD.EXE /C """ & gvsDMIDecode & """ --type " & LCase( myType ) & " 2>&1" )
strOutput = objCMD.StdOut.ReadAll
objCMD.Terminate
Set objCMD = Nothing
On Error Goto 0
HandleDMIDetails = "<h2>\\" & gvsComputer & " " & "DMI " & myType & " details</h2>" & vbCrLf & vbCrLf & "<pre>" & strOutput & "</pre>" & vbCrLf
End Function
Function HandleRegEnum( myHive, myRegPath, myRecursion )
Dim arrSubkeys, arrValueNames, arrValueTypes
Dim blnRecursion
Dim i, intMaxTypeLen, intMaxNameLen, intResult
Dim objReg
Dim strData, strHive, strResult
Dim varData
blnRecursion = ( myRecursion <> 0 )
strResult = ""
intMaxTypeLen = 0
intMaxNameLen = 0
Select Case myHive
Case HKEY_CLASSES_ROOT
strHive = "HKEY_CLASSES_ROOT"
Case HKEY_CURRENT_USER
strHive = "HKEY_CURRENT_USER"
Case HKEY_LOCAL_MACHINE
strHive = "HKEY_LOCAL_MACHINE"
Case HKEY_USERS
strHive = "HKEY_USERS"
Case HKEY_CURRENT_CONFIG
strHive = "HKEY_CURRENT_CONFIG"
Case Else
strHive = myHive
End Select
On Error Resume Next ' REQUIRED
Set objReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!//" & gvsComputer & "/root/default:StdRegProv" )
strResult = "<h2>[" & strHive & "\" & myRegPath & "]</h2>" & vbCrLf
intResult = objReg.EnumValues( myHive, myRegPath, arrValueNames, arrValueTypes )
If intResult = 0 Then
If IsArray( arrValueNames ) And IsArray( arrValueTypes ) Then
For i = 0 To UBound( arrValueNames )
If Len( arrValueNames(i) ) > intMaxNameLen Then intMaxNameLen = Len( arrValueNames(i) )
If Len( gvaRegDataType(arrValueTypes(i)) ) > intMaxTypeLen Then intMaxTypeLen = Len( gvaRegDataType(arrValueTypes(i)) )
Next
For i = 0 To UBound( arrValueNames )
strData = ""
Select Case arrValueTypes(i)
Case REG_SZ:
intResult = objReg.GetStringValue( myHive, myRegPath, arrValueNames(i), strData )
Case REG_EXPAND_SZ:
intResult = objReg.GetExpandedStringValue( myHive, myRegPath, arrValueNames(i), strData )
Case REG_BINARY:
intResult = objReg.GetBinaryValue( myHive, myRegPath, arrValueNames(i), varData )
If Not Err And IsArray( varData ) Then
strData = Join( varData, ";" )
End If
Case REG_DWORD, REG_DWORD_BIG_ENDIAN:
intResult = objReg.GetDWORDValue( myHive, myRegPath, arrValueNames(i), varData )
strData = "0x" & Right( String( 8, "0" ) & CStr( Hex( varData ) ), 8 ) & " (" & varData & ")"
Case REG_MULTI_SZ:
intResult = objReg.GetMultiStringValue( myHive, myRegPath, arrValueNames(i), varData )
strData = Join( varData, ";" )
Case REG_QWORD:
intResult = objReg.GetQWORDValue( myHive, myRegPath, arrValueNames(i), varData )
strData = "0x" & Right( String( 16, "0" ) & CStr( Hex( varData ) ), 16 ) & " (" & varData & ")"
End Select
If intResult = 0 Then
strResult = strResult & Left( arrValueNames(i) & Space( intMaxNameLen + 4 ), intMaxNameLen + 4) & Left( "[" & gvaRegDataType(arrValueTypes(i)) & "]" & Space( intMaxTypeLen + 4 ), intMaxTypeLen + 4 ) & strData & vbCrLf
End If
Next
End If
End If
If blnRecursion And intResult = 0 Then
strResult = strResult & vbCrLf
objReg.EnumKey myHive, myRegPath, arrSubkeys
If Not Err And IsArray( arrSubkeys ) Then
For i = 0 To UBound( arrSubkeys )
strResult = strResult & HandleRegEnum( myHive, myRegPath & "\" & arrSubkeys(i), 1 )
Next
End If
End If
Set objReg = Nothing
On Error Goto 0
HandleRegEnum = strResult
End Function
Function HandleXMLNode( myQuery )
Dim i, strDeviceType, strMsg, strQuery2
Dim colNodes, colNodes2, objNode, objNode2, objNode3, objNode4, objNode5, objNode6, xmlDoc
HandleXMLNode = ""
If gvbWinPE Then Exit Function
strDeviceType = Left( myQuery, InStrRev( myQuery, "/" ) - 1 )
strDeviceType = Mid( strDeviceType, InStrRev( strDeviceType, "/" ) + 1 )
strMsg = "<h2>\\" & gvsComputer & " " & "DxDiag " & strDeviceType & " data</h2>" & vbCrLf & vbCrLf
On Error Resume Next ' REQUIRED
Set xmlDoc = CreateObject( "Microsoft.XMLDOM" )
xmlDoc.Async = "False"
xmlDoc.Load gvaSettingsStr.Item( "XML" )
Set colNodes = xmlDoc.selectNodes( myQuery )
Select Case colNodes.length
Case 0
strMsg = strMsg & "<p>No instances.</p>"
Case 1
strMsg = strMsg & "<p>1 instance:</p>"
Case Else
strMsg = strMsg & "<p>" & colNodes.length & " instances:</p>"
End Select
strMsg = strMsg & vbCrLf & vbCrLf & "<pre>"
For i = 0 To colNodes.length - 1
strQuery2 = myQuery & "[" & i & "]/*"
Set colNodes2 = xmlDoc.selectNodes( strQuery2 )
For Each objNode2 in colNodes2
If objNode2.childNodes.length = 1 Then
strMsg = strMsg & objNode2.nodeName & " = " & objNode2.text & vbCrLf
Else
strMsg = strMsg & objNode2.nodeName & ":" & vbCrLf
For Each objNode3 In objNode2.childNodes
If objNode3.childNodes.length = 1 Then
strMsg = strMsg & " " & objNode3.nodeName & " = " & objNode3.text & vbCrLf
Else
strMsg = strMsg & objNode3.nodeName & ":" & vbCrLf
For Each objNode4 In objNode3.childNodes
If objNode4.childNodes.length = 1 Then
strMsg = strMsg & " " & objNode4.nodeName & " = " & objNode4.text & vbCrLf
Else
strMsg = strMsg & objNode4.nodeName & ":" & vbCrLf
For Each objNode5 In objNode4.childNodes
If objNode5.childNodes.length = 1 Then
strMsg = strMsg & " " & objNode5.nodeName & " = " & objNode5.text & vbCrLf
Else
strMsg = strMsg & objNode5.nodeName & ":" & vbCrLf
For Each objNode6 In objNode5.childNodes
strMsg = strMsg & " " & objNode6.nodeName & " = " & objNode6.text & vbCrLf
Next
End If
Next
End If
Next
End If
Next
End If
Next
strMsg = strMsg & vbCrLf & vbCrLf
Next
strMsg = strMsg & "</pre>" & vbCrLf
Set colNodes2 = Nothing
Set colNodes = Nothing
Set xmlDoc = Nothing
On Error Goto 0
HandleXMLNode = strMsg
End Function
Function HandleXMLValue( myQuery )
Dim i, strDeviceType, strMsg, strQuery2
Dim colNodes, colNodes2, objNode, objNode2, objNode3, xmlDoc
HandleXMLValue = ""
If gvbWinPE Then Exit Function
strDeviceType = Left( myQuery, InStrRev( myQuery, "/" ) - 1 )
strDeviceType = Mid( strDeviceType, InStrRev( strDeviceType, "/" ) + 1 )
strMsg = "<h2>\\" & gvsComputer & " " & "DxDiag " & strDeviceType & " data</h2>" & vbCrLf & vbCrLf
On Error Resume Next ' REQUIRED
Set xmlDoc = CreateObject( "Microsoft.XMLDOM" )
xmlDoc.Async = "False"
xmlDoc.Load gvaSettingsStr.Item( "XML" )
Set colNodes = xmlDoc.selectNodes( myQuery )
Select Case colNodes.length
Case 0
strMsg = strMsg & "<p>No instances.</p>"
Case 1
strMsg = strMsg & "<p>1 instance:</p>"
Case Else
strMsg = strMsg & "<p>" & colNodes.length & " instances:</p>"
End Select
strMsg = strMsg & vbCrLf & vbCrLf & "<pre>"
For i = 0 To colNodes.length - 1
strQuery2 = myQuery & "[" & i & "]"
Set colNodes2 = xmlDoc.selectNodes( strQuery2 )
For Each objNode2 in colNodes2
strMsg = strMsg & objNode2.nodeName & " #" & i & " : " & objNode2.text & vbCrLf
Next
strMsg = strMsg & vbCrLf & vbCrLf
Next
strMsg = strMsg & "</pre>" & vbCrLf
Set colNodes2 = Nothing
Set colNodes = Nothing
Set xmlDoc = Nothing
On Error Goto 0
HandleXMLValue = strMsg
End Function
Sub Initialize( )
Dim i, j, k, objRE
' Read PATH
gvsPATH = Trim( gvoWSHShell.ExpandEnvironmentStrings( "%PATH%" ) )
' Remove empty PATH entries
Set objRE = New RegExp
objRE.Pattern = ";\s+"
gvsPATH = Trim( objRE.Replace( gvsPATH, ";" ) )
objRE.Pattern = ";{2,}"
gvsPATH = Trim( objRE.Replace( gvsPATH, ";" ) )
objRE.Pattern = "(^;|;$)"
gvsPATH = Trim( objRE.Replace( gvsPATH, "" ) )
Set objRE = Nothing
' Split PATH into array of entries
gvaPATH = Split( gvsPATH, ";" )
k = UBound( gvaPATH )
' Trim PATH entries
For i = UBound( gvaPATH ) To 0 Step -1
gvaPATH(i) = Trim( gvaPATH(i) )
' Remove empty PATH entries
If gvaPATH(i) = "" Then
For j = i To k - 1
gvaPATH(j) = gvaPATH(j+1)
Next
k = k - 1
End If
Next
' Resize PATH array to account for removed entries
If k < UBound( gvaPATH ) Then
ReDim Preserve gvaPATH(k)
End If
' Check if in WinPE
gvbWinPE = CheckWinPE( )
If gvbWinPE Then DebugMessage "", "Running in WinPE"
' Reset counters
gvcBanks = 0
gvcCPU = 0
gvcMemory = 0
gviMemSize = 0
gviMemSpeed = 0
gviNumOS = 0
gviMinHeight = Min( 600, window.screen.height )
gviMinWidth = Min( 800, window.screen.width )
' Color changes on WMI connection errors
clrBgErr = "Red"
clrTxtErr = "White"
' This HTA's command line
gvsCommandline = Hardware.CommandLine
gvsCommandlineUC = UCase( gvsCommandline )
' Create a list of all interface colors available, and fill the theme settings dropdowns with them
ListCSSColors
ListColors "BackgroundColor", "blue"
ListColors "CaptionsColor", "white"
ListColors "LinksColor", "red"
ListColors "ButtonFaceColor", "silver"
ListColors "ButtonCaptionsColor", "blacl"
ListColors "CodeColor", "yellow"
' Dictionary objects for global settings
Set gvaDefaultsBool = CreateObject( "Scripting.Dictionary" )
Set gvaDefaultsStr = CreateObject( "Scripting.Dictionary" )
Set gvaSettingsBool = CreateObject( "Scripting.Dictionary" )
Set gvaSettingsStr = CreateObject( "Scripting.Dictionary" )
' Read and set defaults
ConfigReadDefaults
' Paths of helper files
gvsConfigFile = Left( Self.location.pathname, Len( Self.location.pathname ) - 4 ) & ".cfg"
gvsDetailsFile = gvoFSO.BuildPath( gvaSettingsStr.Item( "TEMPDIR" ), "~hardware~details.html" )
gvsPrintFile = gvoFSO.BuildPath( gvaSettingsStr.Item( "TEMPDIR" ), "~hardware~print~preview.html" )
gvsDebugText = ""
End Sub
Sub Inventory( )
Dim blnSuccess, colItems, i, objItem, objWMIService
'ComputerName.value = gvsComputer
gvsComputer = UCase( Trim( ComputerName.value ) )
If ComputerName.value <> UCase( gvsComputer ) Then
If gvsComputer <> "" Then
DebugMessage "", "Changing computer name from " & gvsComputer & " to " & Trim( ComputerName.value )
End If
End If
ComputerName.style.backgroundColor = "White"
ComputerName.style.color = "Black"
ComputerName.disabled = True
gvbIsLocalComputer = IsLocalComputer( )
If ButtonRun.value = "Reset" Then
Reset
Else
ButtonRun.value = "Reset"
ButtonRun.accessKey = "r"
ButtonRun.title = "Click here to clear all fields"
ButtonRun.disabled = True
CheckboxBIOS.disabled = True
CheckboxCDROM.disabled = True
CheckboxCPU.disabled = True
CheckboxFDD.disabled = True
CheckboxHDD.disabled = True
CheckboxKeyboard.disabled = True
CheckboxMouse.disabled = True
CheckboxMainBoard.disabled = True
CheckboxMemory.disabled = True
CheckboxMonitor.disabled = True
CheckboxNIC.disabled = True
CheckboxPorts.disabled = True
CheckboxSound.disabled = True
CheckboxVideo.disabled = True
ButtonBasic.disabled = True
ButtonPaste.disabled = True
ButtonPrint.disabled = True
ComputerName.disabled = True
If Not CheckboxBIOS.Checked Then
BIOSHeader.style.display = "none"
BIOSRow.style.display = "none"
BIOSFooter.style.display = "none"
End If
If Not CheckboxCDROM.Checked Then
CDROMHeader.style.display = "none"
CDROM0.style.display = "none"
CDROMFooter.style.display = "none"
End If
If Not CheckboxCPU.Checked Then
CPUHeader.style.display = "none"
CPURow.style.display = "none"
CPUFooter.style.display = "none"
End If
If Not CheckboxFDD.Checked Then
FDDHeader.style.display = "none"
FDD0.style.display = "none"
FDDFooter.style.display = "none"
End If
If Not CheckboxHDD.Checked Then
HardDiskHeader.style.display = "none"
HardDisk0.style.display = "none"
HardDiskFooter.style.display = "none"
End If
If Not CheckboxKeyboard.Checked Then
KeyboardHeader.style.display = "none"
KeyboardRow.style.display = "none"
KeyboardFooter.style.display = "none"
End If
If Not CheckboxMainBoard.Checked Then
MainBoardHeader.style.display = "none"
MainBoardRow.style.display = "none"
MainBoardFooter.style.display = "none"
End If
If Not CheckboxMemory.Checked Then
MemHeader.style.display = "none"
MemRow.style.display = "none"
MemFooter.style.display = "none"
End If
If Not CheckboxMonitor.Checked Then
MonitorHeader.style.display = "none"
Monitor0.style.display = "none"
MonitorFooter.style.display = "none"
End If
If Not CheckboxMouse.Checked Then
MouseHeader.style.display = "none"
MouseRow.style.display = "none"
MouseFooter.style.display = "none"
End If
If Not CheckboxNIC.Checked Then
NICHeader.style.display = "none"
NIC0.style.display = "none"
NICFooter.style.display = "none"
End If
If Not CheckboxPorts.Checked Then
PortsHeader.style.display = "none"
PortsRow.style.display = "none"
PortsFooter.style.display = "none"
End If
If Not CheckboxSound.Checked Then
SoundHeader.style.display = "none"
SoundRow.style.display = "none"
SoundFooter.style.display = "none"
End If
If Not CheckboxVideo.Checked Then
VideoHeader.style.display = "none"
Video0.style.display = "none"
VideoFooter.style.display = "none"
End If
DebugMessage "", "Starting inventory"
On Error Resume Next ' REQUIRED
If gvbWinPE Then
gvsComputer = UCase( InputBox( "Please enter the computer name", "Computer Name", gvsComputer ) )
ComputerName.value = gvsComputer
Set gvoWMIrootCimv2 = GetObject( "winmgmts://./root/CIMV2" )
Set gvoWMIrootMSWinStorage = GetObject( "winmgmts://./root/Microsoft/Windows/Storage" )
Set gvoWMIrootStandardCimv2 = GetObject( "winmgmts://./root/StandardCimv2" )
Set gvoWMIrootWMI = GetObject( "winmgmts://./root/WMI" )
Else
gvsComputer = ComputerName.value
If gvsComputer = "" Or gvsComputer = "." Then
gvsComputer = GetLocalComputerName( )
ComputerName.value = gvsComputer
End If
Sleep 1
Set colItems = gvoWMIlocalCimv2.ExecQuery( "SELECT StatusCode FROM Win32_PingStatus WHERE Address='" & gvsComputer & "'" )
For Each objItem In colItems
If IsNull( objItem.StatusCode ) Or objItem.StatusCode <> 0 Then
On Error GoTo 0
MsgBox "Error while trying to ping computer " & gvsComputer, vbOKOnly, "Connection Error"
Reset
Exit Sub
End If
Next
Set gvoWMIrootCimv2 = GetObject( "winmgmts://" & gvsComputer & "/root/CIMV2" )
If Err Then
MsgBox "Error " & Err.Number & " while trying to get access to " & gvsComputer & ": " & Err.Description, vbOKOnly, "Remote WMI Error"
On Error GoTo 0
Reset
Exit Sub
End If
Set gvoWMIrootMSWinStorage = GetObject( "winmgmts://" & gvsComputer & "/root/Microsoft/Windows/Storage" )
Set gvoWMIrootStandardCimv2 = GetObject( "winmgmts://" & gvsComputer & "/root/StandardCimv2" )
Set gvoWMIrootWMI = GetObject( "winmgmts://" & gvsComputer & "/root/WMI" )
End If
' Diable WinSAT for Windows XP and older
If CInt( Left( CStr( gviNumOS ), 1 ) ) < 6 Then gvaDefaultsBool.Item( "NOSCORES" ) = True
EnableWinSATScores
On Error Goto 0
gvsHeader = "Computer:" & vbTab & "WinPE"
gvsCSVTxt = gvsComputer & vbTab & CStr( gvbWinPE )
InventoryWinSATScores
InventoryCPU
InventoryMemory
InventoryFDD
InventoryHDD
InventoryCDROM
InventoryVideo
InventoryMonitor
InventorySound
InventoryNIC
InventoryMainBoard
InventoryKeyboard
InventoryMouse
InventoryPorts
InventoryBIOS
If CheckboxVideo.Checked Then
If gvaSettingsBool.Item( "DXDIAG" ) Then
blnSuccess = InventoryDirectX( )
If Not blnSuccess Then MsgBox "There was an error reading the DirectX data:" & vbCrLf & "Unable to load """ & gvaSettingsStr.Item( "XML" ) & """", vbOKOnly, "XML error"
End If
Add2CsvVideo
End If
If gvaSettingsBool.Item( "DEVTEST" ) Then
ComputerName.value = "MYPC"
InputDxDiag.value = "C:\Scripts\Hardware.xml"
Else
ComputerName.value = gvsComputer
End If
' Write the inventory data to the hidden area named "PrintScreen".
' This allows printing with Ctrl+P instead of the Print button.
PrintScreen.innerHTML = PrintTable( )
Set colItems = document.getElementsByTagName( "input" )
For Each objItem In colItems
If objItem.type = "text" Then
objItem.title = objItem.value
End If
Next
Set colItems = Nothing
ButtonCopy.disabled = False
ButtonPrint.disabled = False
ButtonSave.disabled = False
ButtonRun.disabled = False
ButtonSave.Focus( )
End If
DebugMessage "", "End of inventory"
End Sub
Sub InventoryBIOS( )
Dim colItems, objItem, objMatches, objRE
Dim strBIOSDate, strBIOSVersion
On Error Resume Next ' REQUIRED
If CheckBoxBIOS.Checked Then
Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_BIOS WHERE PrimaryBIOS = True" )
If Not Err Then
For Each objItem In colItems
strBIOSVersion = objItem.SMBIOSBIOSVersion
strBIOSDate = Mid( objItem.ReleaseDate, 5, 2 ) & "/" & Mid( objItem.ReleaseDate, 7, 2 ) & "/" & Left( objItem.ReleaseDate, 4 )
gvsBIOSSerial = objItem.SerialNumber
If InStr( strBIOSVersion, ":" ) Then ' Convert 01:23:00 to 1.23.00
Set objRE = New RegExp
objRE.Pattern = "^\d+(:\d+)+$"
If objRE.Test( strBIOSVersion ) Then
strBIOSVersion = Replace( strBIOSVersion, ":", "." )
If Len( strBIOSVersion ) > 3 Then
If Left( strBIOSVersion, 1 ) = "0" And Not Left( strBIOSVersion, 2 ) = "0." Then
strBIOSVersion = Mid( strBIOSVersion, 2 )
End If
End If
End If
End If
If gvaSettingsBool.Item( "DEVTEST" ) Then strBIOSVersion = gvoRandom.Next_2( 1, 9 ) & "." & gvoRandom.Next_2( 0, 9 ) & gvoRandom.Next_2( 0, 9 )
BIOSManufacturer.value = objItem.Manufacturer
BIOSModel.value = objItem.Name
BIOSVersion.value = strBIOSVersion
BIOSDate.value = strBIOSDate
ButtonDetailsBIOS.disabled = False
Next
End If
DebugMessage "", "BIOS inventory succeeded: " & CStr( Not ButtonDetailsBIOS.disabled )
Add2CsvBIOS
End If
On Error Goto 0
End Sub
Sub InventoryCDROM( )
Dim arrDeviceID, arrHardwareID, arrFirmware
Dim i, intIndex, intRow
Dim colItems, objCDROMFirmwares, objCDROMInterfaces, objCDROMModels, objCell, objItem, objTable, objTableRow
Dim strDeviceID, strDriveLetter, strElement, strFirmware, strInterface
If CheckboxCDROM.Checked Then
On Error Resume Next ' REQUIRED
' Find all CDROM drives without the word "virtual" in their name
Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_CDROMDrive WHERE NOT Name LIKE '%Virtual%'" )
If Err Or IsNull( colItems ) Or colItems.Count = 0 Then
On Error Goto 0
If gvbWinPE And gvsWinDrive <> "" Then InventoryCDROMWinPE
Else
Set objCDROMFirmwares = CreateObject( "System.Collections.Sortedlist" )
Set objCDROMInterfaces = CreateObject( "System.Collections.Sortedlist" )
Set objCDROMModels = CreateObject( "System.Collections.Sortedlist" )
For Each objItem In colItems
' Use drive letter without colon as key for CDROM SortedLists
strDriveLetter = Left( objItem.Drive, 1 )
' Parse the PNP Device ID string to get the interface and firmware revision
' Example:
' IDE\CDROM_NEC_DVD_RW_ND-3520AW___________________3.05____\5&2E27B08F&0&0.0.0
' === <- interface ==== <- firmware revision
' The array arrDeviceID will contain 3 elements: "IDE",
' "CDROM_NEC_DVD_RW_ND-3520AW___________________3.05____" and "5&2E27B08F&0&0.0.0"
If InStr( objItem.DeviceID, "\" ) Then
arrDeviceID = Split( Replace( objItem.DeviceID, "&", "&" ), "\", 3, vbTextCompare )
strInterface = arrDeviceID(0)
strDeviceID = arrDeviceID(1)
' In our example, strDeviceID will contain "CDROM_NEC_DVD_RW_ND-3520AW___________________3.05____"
' The array arrFirmware will contain the elements "CDROM", "NEC", "DVD", "RW", "ND-3520AW", "3.05" and ""
' strFirmware is assigned the value of the last non-empty element in the array
If InStr( strDeviceID, "_" ) Then
arrFirmware = Split( strDeviceID, "_", -1, vbTextCompare )
If Left( strInterface, 3 ) = "USB" Then strInterface = "USB"
For Each strElement In arrFirmware
If CStr( strElement ) <> "" Then strFirmware = strElement
Next
End If
If gvaSettingsBool.Item( "DEVTEST" ) Then strFirmware = gvoRandom.Next_2( 1, 9 ) & "." & gvoRandom.Next_2( 0, 9 ) & gvoRandom.Next_2( 0, 9 )
objCDROMModels.Item( strDriveLetter ) = objItem.Name
objCDROMInterfaces.Item( strDriveLetter ) = strInterface
objCDROMFirmwares.Item( strDriveLetter ) = strFirmware
End If
Next
Set objTable = document.getElementById( "Results" )
intRow = document.getElementById( "CDROM0" ).rowIndex
CDROM0Index.value = objCDROMModels.GetKey( 0 ) & ":"
CDROM0Model.value = objCDROMModels.GetByIndex( 0 )
CDROM0Firmware.value = objCDROMFirmwares.GetByIndex( 0 )
CDROM0Interface.value = objCDROMInterfaces.GetByIndex( 0 )
If objCDROMModels.Count > 1 Then
document.getElementById( "MultipleCDROMs" ).style.display = "inline"
For i = 1 To objCDROMModels.Count - 1
Set objTableRow = objTable.insertRow( intRow + i )
objTableRow.id = "CDROM" & i
Set objCell = objTableRow.insertCell( 0 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 1 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 2 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 3 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 4 )
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""CDROM" & i & "Index"" size=""12"" value=""" & objCDROMModels.GetKey( i ) & ":"" readonly />"
Set objCell = objTableRow.insertCell( 5 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 6 )
objCell.setAttribute "colSpan", 3
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""CDROM" & i & "Model"" size=""40"" value=""" & objCDROMModels.GetByIndex( i ) & """ readonly />"
Set objCell = objTableRow.insertCell( 7 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 8 )
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""CDROM" & i & "Firmware"" size=""16"" value=""" & objCDROMFirmwares.GetByIndex( i ) & """ readonly />"
Set objCell = objTableRow.insertCell( 9 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 10 )
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""CDROM" & i & "Interface"" size=""16"" value=""" & objCDROMInterfaces.GetByIndex( i ) & """ readonly />"
Set objCell = Nothing
Set objTableRow = Nothing
Next
End If
ButtonDetailsCDROM.disabled = ( objCDROMModels.Count = 0 )
DebugMessage "", "CDROM inventory succeeded: " & CStr( Not ButtonDetailsCDROM.disabled )
Set objTable = Nothing
Set objCDROMModels = Nothing
Set objCDROMFirmwares = Nothing
Set objCDROMInterfaces = Nothing
On Error Goto 0
Add2CsvCDROM
End If
End If
End Sub
Sub InventoryCDROMWinPE( )
Dim arrHardwareID, arrRegKeys, arrSubKeys, arrTest
Dim dicDescriptions, dicFirmware, dicHardwareIDs, dicInterfaces
Dim colItems, objItem, objRE, objReg
Dim i, intIndex, j
Dim strDescription, strDictKey, strRegKey, strRegSubKey, strWMIQuery
Set dicDescriptions = CreateObject( "Scripting.Dictionary" )
Set dicFirmware = CreateObject( "Scripting.Dictionary" )
Set dicHardwareIDs = CreateObject( "Scripting.Dictionary" )
Set dicInterfaces = CreateObject( "Scripting.Dictionary" )
Set objRE = New RegExp
' Mount registry hive from Windows Drive
gvoWSHShell.Run "CMD.EXE /C REG.EXE Load HKLM\TempHive " & gvsWinDrive & "\windows\system32\config\system", 0, True
' Scan the temporary registry hive for IDE CDROM devices
strWMIQuery = "winmgmts:{impersonationLevel=impersonate}!//./root/default:StdRegProv"
Set objReg = GetObject( strWMIQuery )
objReg.EnumKey HKEY_LOCAL_MACHINE, "TempHive\ControlSet001\Enum\IDE", arrRegKeys
If Not IsNull( arrRegKeys ) Then
For i = 0 To UBound( arrRegKeys )
strRegKey = arrRegKeys(i)
If Left( UCase( strRegKey ), 5 ) = "CDROM" Then
objReg.EnumKey HKEY_LOCAL_MACHINE, "TempHive\ControlSet001\Enum\IDE\" & strRegKey, arrSubKeys
For Each strRegSubKey In arrSubKeys
objReg.GetMultiStringValue HKEY_LOCAL_MACHINE, "TempHive\ControlSet001\Enum\IDE\" & strRegKey & "\" & strRegSubKey, "HardwareID", arrHardwareID
If Not IsNull( arrHardwareID ) Then
If InStr( UCase( arrHardwareID(0) ), "VIRTUAL" ) = 0 Then
If Left( UCase( arrHardwareID(0) ), 4 ) = "IDE\" Then arrHardwareID(0) = Mid( arrHardwareID(0), 5 )
If Left( UCase( arrHardwareID(0) ), 5 ) = "CDROM" Then arrHardwareID(0) = Mid( arrHardwareID(0), 6 )
objReg.GetStringValue HKEY_LOCAL_MACHINE, "TempHive\ControlSet001\Enum\IDE\" & strRegKey & "\" & strRegSubKey, "FriendlyName", strDescription
strDictKey = objRE.Replace( arrHardwareID(0), "" )
dicHardwareIDs.Item( strDictKey ) = arrHardwareID(0)
dicDescriptions.Item( strDictKey ) = strDescription
dicInterfaces.Item( strDictKey ) = "IDE"
arrTest = Split( arrHardwareID(0), "_" )
For j = 0 To UBound( arrTest )
If Not arrTest(i) = "" Then
dicFirmware.Item( strDictKey ) = arrTest(j)
End If
Next
End If
arrHardwareID = Null
End If
Next
arrSubKeys = Null
End If
Next
arrRegKeys = Null
End If
' Scan the temporary registry hive for SCSI CDROM devices
objReg.EnumKey HKEY_LOCAL_MACHINE, "TempHive\ControlSet001\Enum\SCSI", arrRegKeys
If Not IsNull( arrRegKeys ) Then
For Each strRegKey In arrRegKeys
If Left( UCase( strRegKey ), 5 ) = "CDROM" Then
objReg.EnumKey HKEY_LOCAL_MACHINE, "TempHive\ControlSet001\Enum\SCSI\" & strRegKey, arrSubKeys
For Each strRegSubKey In arrSubKeys
objReg.GetMultiStringValue HKEY_LOCAL_MACHINE, "TempHive\ControlSet001\Enum\SCSI\" & strRegKey & "\" & strRegSubKey, "HardwareID", arrHardwareID
If Not IsNull( arrHardwareID ) Then
If InStr( UCase( arrHardwareID(0) ), "VIRTUAL" ) = 0 Then
If Left( UCase( arrHardwareID(0) ), 5 ) = "SCSI\" Then arrHardwareID(0) = Mid( arrHardwareID(0), 6 )
If Left( UCase( arrHardwareID(0) ), 5 ) = "CDROM" Then arrHardwareID(0) = Mid( arrHardwareID(0), 6 )
objReg.GetStringValue HKEY_LOCAL_MACHINE, "TempHive\ControlSet001\Enum\SCSI\" & strRegKey & "\" & strRegSubKey, "FriendlyName", strDescription
strDictKey = objRE.Replace( arrHardwareID(0), "" )
dicHardwareIDs.Item( strDictKey ) = arrHardwareID(0)
dicDescriptions.Item( strDictKey ) = strDescription
dicInterfaces.Item( strDictKey ) = "SCSI"
arrTest = Split( arrHardwareID(0), "_" )
For i = 0 To UBound( arrTest )
If Not arrTest(i) = "" Then
dicFirmware.Item( strDictKey ) = arrTest(i)
End If
Next
End If
arrHardwareID = Null
End If
Next
arrSubKeys = Null
End If
Next
arrRegKeys = Null
End If
' Show the results
If dicHardwareIDs.Count > 0 Then
CDROM0Index.value = dicDescriptions.Keys(0)
CDROM0Model.value = dicDescriptions(0)
CDROM0Firmware.value = dicFirmware(0)
CDROM0Interface.value = dicInterfaces(0)
If objCDROMModels.Count > 1 Then
MultipleCDROMs.style.display = "inline"
Set objTable = document.getElementById( "Results" )
intRow = document.getElementById( "CDROM0" ).rowIndex
For i = 1 To objCDROMModels.Count - 1
Set objTableRow = objTable.insertRow( intRow + i )
objTableRow.id = "CDROM" & i
Set objCell = objTableRow.insertCell( 0 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 1 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 2 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 3 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 4 )
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""CDROM" & i & "Index"" size=""12"" value=""" & dicDescriptions.Keys(i) & ":"" readonly />"
Set objCell = objTableRow.insertCell( 5 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 6 )
objcell.setAttribute "colSpan", 3
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""CDROM" & i & "Model"" size=""40"" value=""" & dicDescriptions(i) & """ readonly />"
Set objCell = objTableRow.insertCell( 7 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 8 )
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""CDROM" & i & "Firmware"" size=""16"" value=""" & dicFirmware(i) & """ readonly />"
Set objCell = objTableRow.insertCell( 9 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 10 )
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""CDROM" & i & "Interface"" size=""16"" value=""" & dicInterfaces(i) & """ readonly />"
Set objCell = Nothing
Set objTableRow = Nothing
Next
Set objTable = Nothing
End If
End If
DebugMessage "", "CDROM inventory succeeded: " & CStr( Not ButtonDetailsCDROM.disabled )
' Unmount temporary registry hive
gvoWSHShell.Run "CMD.EXE /C REG.EXE Unload HKLM\TempHive", 0, True
Set dicDescriptions = Nothing
Set dicFirmware = Nothing
Set dicHardwareIDs = Nothing
Set dicInterfaces = Nothing
Set objRE = Nothing
Add2CsvCDROM
End Sub
Sub InventoryCPU( )
Dim colItems, objItem
If CheckBoxCPU.Checked Then
On Error Resume Next ' REQUIRED
Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_Processor" )
If Not Err Then
gvcCPU = colItems.Count
CPUNumber.value = gvcCPU
If gvcCPU > 1 Then MultipleCPU.InnerHTML = "s"
For Each objItem In colItems
CPUModel.value = Trim( objItem.Name )
CPUSpeed.value = objItem.CurrentClockSpeed
CPUSocket.value = objItem.SocketDesignation
Next
ButtonDetailsCPU.disabled = False
End If
On Error Goto 0
DebugMessage "", "CPU inventory succeeded: " & CStr( Not ButtonDetailsCPU.disabled )
Add2CsvCPU
End If
End Sub
Function InventoryDirectX( )
Dim blnLoaded, i
Dim colItems, colNodes, objItem, objNode, xmlDoc
Dim strDxDiag, strQuery, strSysDir
strSysDir = gvoWSHShell.ExpandEnvironmentStrings( "%Windir%\System32" )
strDxDiag = gvoFSO.BuildPath( strSysDir, "DxDiag.exe" )
' Delete old XML file if it exists, unless specified otherwise
If Not gvaSettingsBool.Item( "KEEPXML" ) Then
If gvoFSO.FileExists( gvaSettingsStr.Item( "XML" ) ) Then gvoFSO.DeleteFile gvaSettingsStr.Item( "XML" ), True
End If
' Run DXDIAG.EXE, if required, and save results in XML file
If gvoFSO.FileExists( gvaSettingsStr.Item( "XML" ) ) Then
If Not gvaSettingsBool.Item( "KEEPXML" ) Then
gvoFSO.DeleteFile gvaSettingsStr.Item( "XML" ), True
Sleep 2
gvoWSHShell.Run strDxDiag & " /whql:off /x " & gvaSettingsStr.Item( "XML" ), 7, False
End If
Else
gvoWSHShell.Run strDxDiag & " /whql:off /x " & gvaSettingsStr.Item( "XML" ), 7, False
End If
' Wait until XML file is created, 5 minutes maximum
For i = 1 To 150
Sleep 1
If gvoFSO.FileExists( gvaSettingsStr.Item( "XML" ) ) Then Exit For
Sleep 1
Next
' Wait for DXDIAG to close, 30 seconds maximum
Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_Process WHERE Caption='DxDiag.exe'" )
For i = 1 To 5
If colItems.count = 0 Then Exit For
Sleep 6
Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_Process WHERE Caption='DxDiag.exe'" )
Next
' Open the XML file created by DXDIAG
Set xmlDoc = CreateObject( "Microsoft.XMLDOM" )
xmlDoc.Async = "False"
blnLoaded = xmlDoc.Load( gvaSettingsStr.Item( "XML" ) )
If Not blnLoaded Then
' Retry 5 times maximum, with 6 seconds interval
For i = 1 To 15
Sleep 2
blnLoaded = xmlDoc.Load( gvaSettingsStr.Item( "XML" ) )
If blnLoaded Then Exit For
Next
Sleep 2
MsgBox "Process DxDiag.exe still running", vbOKOnly, "DxDiag error"
End If
If blnLoaded Then
ReDim gvaVideo( 4, 0 )
strQuery = "/DxDiag/DisplayDevices/DisplayDevice/DisplayMemory"
Set colNodes = xmlDoc.selectNodes( strQuery )
i = 0
For Each objNode in colNodes
ReDim Preserve gvaVideo( 4, i )
gvaVideo( 0, i ) = Trim( Replace( objNode.text, "MB", "" ) )
i = i + 1
Next
strQuery = "/DxDiag/DisplayDevices/DisplayDevice/CurrentMode"
Set colNodes = xmlDoc.selectNodes( strQuery )
i = 0
For Each objNode in colNodes
gvaVideo( 1, i ) = Trim( objNode.text )
i = i + 1
Next
strQuery = "/DxDiag/DisplayDevices/DisplayDevice/MonitorName"
Set colNodes = xmlDoc.selectNodes( strQuery )
i = 0
For Each objNode in colNodes
gvaVideo( 2, i ) = Trim( objNode.text )
i = i + 1
Next
strQuery = "/DxDiag/DisplayDevices/DisplayDevice/MonitorModel"
Set colNodes = xmlDoc.selectNodes( strQuery )
i = 0
For Each objNode in colNodes
gvaVideo( 3, i ) = Trim( objNode.text )
i = i + 1
Next
strQuery = "/DxDiag/DisplayDevices/DisplayDevice/CardName"
Set colNodes = xmlDoc.selectNodes( strQuery )
i = 0
For Each objNode in colNodes
gvaVideo( 4, i ) = Trim( objNode.text )
i = i + 1
Next
InventoryDirectX = True
Else
InventoryDirectX = False
End If
' Clean up
Set colNodes = Nothing
Set xmlDoc = Nothing
DebugMessage "", "DirectX inventory succeeded: " & CStr( InventoryDirectX )
End Function
Sub InventoryFDD( )
Dim cntAllFloppy, cntIntFloppy, cntUSBFloppy, i, intRow
Dim colItems, colItems2, objCell, objFDDCapacities, objFDDDescriptions, objFDDInterfaces, objItem, objItem2, objRE, objTable, objTableRow
Dim strDriveLetter, strInterface, strQuery
If CheckboxFDD.Checked Then
On Error Resume Next ' REQUIRED
strInterface = "Unknown"
cntAllFloppy = 0
cntIntFloppy = 0
cntUSBFloppy = 0
' Count total number of floppy disk drives
strQuery = "SELECT * FROM Win32_PnPEntity WHERE PNPClass='FloppyDisk'"
Set colItems = gvoWMIrootCimv2.ExecQuery( strQuery )
If Not Err Then cntAllFloppy = colItems.Count
' Count number of USB-attached floppy disk drives
strQuery = "SELECT * FROM Win32_PnPEntity WHERE PNPDeviceID LIKE 'USBSTOR%FLOPPY%'"
Set colItems = gvoWMIrootCimv2.ExecQuery( strQuery )
If Not Err Then cntUSBFloppy = colItems.Count
' Count number of internal floppy drive connectors
strQuery = "SELECT * FROM Win32_PortConnector"
Set colItems = gvoWMIrootCimv2.ExecQuery( strQuery )
If Not Err Then
For Each objItem In colItems
If objItem.PortType <> Null Then
For i = 0 To Len( objItem.PortType ) - 1
If objItem.PortType(i) = 89 Or objItem.PortType(i) = 91 Then
cntIntFloppy = cntIntFloppy + 1
End If
Next
End If
Next
End If
' Check if all floppy drives have identical interface types; if not, too bad, it is impossible to link a specific floppy drive to a specific interface
If cntAllFloppy = cntUSBFloppy Then
strInterface = "USB"
ElseIf cntUSBFloppy = 0 And cntIntFloppy >= cntAllFloppy Then
strInterface = "Flatcable"
End If
' Find all floppy disk drives
strQuery = "SELECT * FROM Win32_LogicalDisk WHERE DriveType=2 AND MediaType IS NOT NULL AND MediaType != 0 AND MediaType != 11 AND MediaType != 12"
Set colItems = gvoWMIrootCimv2.ExecQuery( strQuery )
If colItems.Count > 0 And Not Err Then
Set objFDDCapacities = CreateObject( "System.Collections.Sortedlist" )
Set objFDDDescriptions = CreateObject( "System.Collections.Sortedlist" )
Set objFDDInterfaces = CreateObject( "System.Collections.Sortedlist" )
Set objRE = New RegExp
For Each objItem In colItems
If Trim( "" & objItem.DeviceId ) <> "" Then
strDriveLetter = Left( objItem.DeviceId, 1 )
'Set colItems2 = objWMIService.ExecQuery( "SELECT * FROM MSFT_Volume WHERE DriveLetter=""" & strDriveLetter & """" )
objRE.Pattern = "[\d\.]+\s*[MK]B$"
objRE.IgnoreCase = True
If objRE.Test( GetMediaType( objItem.MediaType ) ) Then
objFDDCapacities.Item( strDriveLetter ) = objRE.Execute( GetMediaType( objItem.MediaType ) )(0)
Else
objFDDCapacities.Item( strDriveLetter ) = "Unknown"
End If
objFDDDescriptions.Item( strDriveLetter ) = objItem.Description
objFDDInterfaces.Item( strDriveLetter ) = strInterface
End If
Next
FDD0DeviceID.value = objFDDDescriptions.GetKey( 0 ) & ":"
FDD0Description.value = objFDDDescriptions.GetByIndex( 0 )
FDD0Capacity.value = objFDDCapacities.GetByIndex( 0 )
FDD0Interface.value = objFDDInterfaces.GetByIndex( 0 )
If objFDDDescriptions.Count > 1 Then
document.getElementById( "MultipleFDDs" ).style.display = "inline"
Set objTable = document.getElementById( "Results" )
intRow = document.getElementById( "FDD0" ).rowIndex
For i = 1 To objFDDDescriptions.Count - 1
Set objTableRow = objTable.insertRow( intRow + i )
objTableRow.id = "FDD" & i
Set objCell = objTableRow.insertCell( 0 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 1 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 2 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 3 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 4 )
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""FDD" & i & "DeviceID"" size=""12"" value=""" & objFDDDescriptions.GetKey( i ) & ":"" readonly />"
Set objCell = objTableRow.insertCell( 5 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 6 )
objcell.setAttribute "colSpan", 3
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""FDD" & i & "Description"" size=""40"" value=""" & objFDDDescriptions.GetByIndex( i ) & """ readonly />"
Set objCell = objTableRow.insertCell( 7 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 8 )
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""FDD" & i & "Capacity"" size=""16"" value=""" & objFDDCapacities.GetByIndex( i ) & """ readonly />"
Set objCell = objTableRow.insertCell( 9 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 10 )
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""FDD" & i & "Interface"" size=""16"" value=""" & objFDDInterfaces.GetByIndex( i ) & """ readonly />"
Set objCell = Nothing
Set objTableRow = Nothing
Next
Set objTable = Nothing
End If
Set objFDDDescriptions = Nothing
Set objFDDInterfaces = Nothing
ButtonDetailsFDD.disabled = False
End If
On Error GoTo 0
DebugMessage "", "FDD inventory succeeded: " & CStr( Not ButtonDetailsFDD.disabled )
Add2CsvFDD
End If
End Sub
Sub InventoryHDD( )
Dim i, intRow
Dim colItems, objCell, objHDDInterfaces, objHDDModels, objHDDSizes, objItem, objTable, objTableRow
Dim strQuery
If CheckboxHDD.Checked Then
On Error Resume Next ' REQUIRED
strQuery = "SELECT * FROM MSFT_PhysicalDisk"
Set colItems = gvoWMIrootMSWinStorage.ExecQuery( strQuery )
If Not Err Then
' Using SortedList instead of array because there may be "gaps" in the list of disk indexes
Set objHDDInterfaces = CreateObject( "System.Collections.Sortedlist" )
Set objHDDModels = CreateObject( "System.Collections.Sortedlist" )
Set objHDDSizes = CreateObject( "System.Collections.Sortedlist" )
For Each objItem In colItems
If gvaSettingsBool.Item( "USBSTOR" ) Or Not GetBusType( objItem.BusType ) = "USB" Then
If gvaSettingsBool.Item( "VIRTUAL" ) Or InStr( LCase( objItem.FriendlyName ), "virtual" ) = 0 Then
objHDDModels.Item( CInt( objItem.DeviceID ) ) = objItem.FriendlyName
objHDDSizes.Item( CInt( objItem.DeviceID ) ) = Round( objItem.Size / GB )
objHDDInterfaces.Item( CInt( objItem.DeviceID ) ) = GetBusType( objItem.BusType )
End If
End If
Next
HardDisk0Index.value = objHDDModels.GetKey( 0 ) & ":"
HardDisk0Model.value = objHDDModels.GetByIndex( 0 )
HardDisk0Size.value = objHDDSizes.GetByIndex( 0 )
HardDisk0Interface.value = objHDDInterfaces.GetByIndex( 0 )
ButtonDetailsHDD.disabled = False
If objHDDModels.Count > 1 Then
document.getElementById( "MultipleHDUs" ).style.display = "inline"
Set objTable = document.getElementById( "Results" )
intRow = document.getElementById( "HardDisk0" ).rowIndex
For i = 1 To objHDDModels.Count - 1
Set objTableRow = objTable.insertRow( intRow + i )
objTableRow.id = "HardDisk" & i
Set objCell = objTableRow.insertCell( 0 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 1 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 2 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 3 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 4 )
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""HardDisk" & i & "Index"" size=""12"" value=""" & objHDDModels.GetKey( i ) & """ readonly />"
Set objCell = objTableRow.insertCell( 5 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 6 )
objCell.setAttribute "colSpan", 3
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""HardDisk" & i & "Model"" size=""40"" value=""" & objHDDModels.GetByIndex( i ) & """ readonly />"
Set objCell = objTableRow.insertCell( 7 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 8 )
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""HardDisk" & i & "Size"" size=""16"" value=""" & objHDDSizes.GetByIndex( i ) & """ readonly />"
Set objCell = objTableRow.insertCell( 9 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 10 )
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""HardDisk" & i & "Interface"" size=""16"" value=""" & objHDDInterfaces.GetByIndex( i ) & """ readonly />"
Set objCell = Nothing
Set objTableRow = Nothing
Next
Set objTable = Nothing
End If
Set objHDDInterfaces = Nothing
Set objHDDModels = Nothing
Set objHDDSizes = Nothing
End If
On Error Goto 0
DebugMessage "", "HDD inventory succeeded: " & CStr( Not ButtonDetailsHDD.disabled )
Add2CsvHDD
End If
End Sub
Sub InventoryKeyboard( )
Dim arrConnectorTypes, arrHardwareTypes
Dim blnHideFkeys
Dim intButtons, intConnectorType, intCount, intFkeys, intLEDs
Dim colItems, objItem
Dim strConnectorType, strKbdPNP, strMouseModel, strMouseType
If CheckboxKeyboard.checked Then
' Enumeration of connector and hardware types
arrConnectorTypes = Array( "I8042", "Serial", "USB" )
ReDim Preserve arrDeviceInterfaces( 162 )
arrDeviceInterfaces( 160 ) = "Bus mouse DB-9"
arrDeviceInterfaces( 161 ) = "Bus mouse micro-DIN"
arrDeviceInterfaces( 162 ) = "USB"
On Error Resume Next ' REQUIRED
blnHideFkeys = Not gvbIsElevated
' Check for keyboard details in root/WMI - this may fail on access denied errors when not running with elevated privileges
intCount = 0
strKbdPNP = ""
Set colItems = gvoWMIrootWMI.ExecQuery( "SELECT * FROM MSKeyboard_PortInformation WHERE Active = True" )
If Not Err Then
intCount = colItems.Count
If intCount > 1 Then
Set colItems = gvoWMIrootWMI.ExecQuery( "SELECT * FROM MSKeyboard_PortInformation WHERE Active = True AND Instancename LIKE 'HID\\%'" )
intCount = colItems.Count
If colItems.Count = 0 Then
Set colItems = gvoWMIrootWMI.ExecQuery( "SELECT * FROM MSKeyboard_PortInformation WHERE Active = True AND Instancename LIKE '%&%'" )
End If
End If
For Each objItem In colItems
intFkeys = 0
intLEDs = 0
strKbdPNP = Split( objItem.InstanceName, "\" )(1)
intFkeys = objItem.FunctionKeys
intLEDs = objItem.Indicators
KeyboardFkLEDs.value = intFkeys & " F-keys; " & intLEDs & " LEDs"
intConnectorType = objItem.ConnectorType
If Not IsEmpty( intConnectorType ) Then
strConnectorType = arrConnectorTypes( intConnectorType )
KeyboardConnector.value = strConnectorType
End If
blnHideFkeys = ( intFkeys = 0 And intLEDs = 0 )
Next
ButtonDetailsKeyboard.disabled = False
End If
If strKbdPNP = "" Then
' Check for keyboard details in root/CIMV2 - this is less likely to fail on access denied errors
intCount = 0
Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_Keyboard" )
If Not Err Then
intCount = colItems.Count
If intCount > 1 Then
Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_Keyboard WHERE NOT PNPDeviceID LIKE 'ACPI\\%'" )
intCount = colItems.Count
If colItems.Count = 0 Then
Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_Keyboard" )
End If
End If
For Each objItem In colItems
If KeyboardModel.value = "" Then KeyboardModel.value = objItem.Description
If KeyboardType.value = "" Then KeyboardType.value = objItem.Name
If KeyboardFkLEDs.value = "" Then
intFkeys = objItem.NumberOfFunctionkeys
If Not IsEmpty( intFkeys ) And intFkeys > 0 Then KeyboardFkLEDs.value = intFkeys & " F-keys"
End If
KeyboardModel.value = objItem.Description
KeyboardType.value = objItem.Name
If KeyboardConnector.value = "" Then
strConnectorType = Split( objItem.PNPDeviceID, "\" )(0)
KeyboardConnector.value = strConnectorType
End If
Next
ButtonDetailsKeyboard.disabled = False
End If
Else
Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_Keyboard WHERE PNPDeviceID LIKE '%\\" & strKbdPNP & "\\%'" )
If Not Err Then
For Each objItem In colItems
KeyboardModel.value = objItem.Description
KeyboardType.value = objItem.Name
Next
ButtonDetailsKeyboard.disabled = False
End If
End If
If blnHideFkeys Then
' If not running with elevated privileges, this field contains nonsense
KeyboardHeaderFkLEDs.style.visibility = "hidden"
KeyboardFkLEDs.style.visibility = "hidden"
Else
KeyboardHeaderFkLEDs.style.visibility = "visible"
KeyboardFkLEDs.style.visibility = "visible"
End if
On Error Goto 0
DebugMessage "", "Keyboard inventory succeeded: " & CStr( Not ButtonDetailsKeyboard.disabled )
Add2CsvKbd
End If
End Sub
Sub InventoryMainBoard( )
Dim colItems, objItem, strMBVersion
If CheckboxMainBoard.Checked Then
On Error Resume Next ' REQUIRED
Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_BaseBoard" )
If Not Err Then
For Each objItem In colItems
If gvaSettingsBool.Item( "DEVTEST" ) Then
strMBVersion = gvoRandom.Next_2( 1, 9 ) & "." & gvoRandom.Next_2( 0, 9 ) & gvoRandom.Next_2( 0, 9 )
Else
strMBVersion = objItem.Version
End If
MBManufacturer.value = objItem.Manufacturer
MBModel.value = objItem.Product
MBVersion.value = strMBVersion
Next
ButtonDetailsMainBoard.disabled = False
End If
On Error Goto 0
ChassisType.value = GetChassis( )
Add2CsvMainBoard
End If
On Error GoTo 0
DebugMessage "", "Main Board inventory succeeded: " & CStr( Not ButtonDetailsMainBoard.disabled )
End Sub
Sub InventoryMemory( )
Dim colItems, objItem
If CheckboxMemory.Checked Then
On Error Resume Next ' REQUIRED
' Capacity filter intended for HP/COMPAQ EVO models
Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_PhysicalMemory WHERE Capacity > 524288" )
If Not Err Then
For Each objItem in colItems
gvcMemory = gvcMemory + 1
gviMemSize = gviMemSize + objItem.Capacity
If gviMemSpeed = 0 Or objItem.Speed < gviMemSpeed Then gviMemSpeed = objItem.Speed
Next
MemoryModules.value = gvcMemory
MemorySize.value = Round( gviMemSize / MB )
Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_PhysicalMemoryArray" )
For Each objItem In colItems
If objItem.MemoryDevices > gvcBanks Then gvcBanks = objItem.MemoryDevices
Next
ButtonDetailsMemory.disabled = False
End If
On Error Goto 0
MemoryBanks.value = gvcBanks
MemoryFormfactor.value = GetMemoryFormFactor( )
MemorySpeed.value = gviMemSpeed
DebugMessage "", "Memory inventory succeeded: " & CStr( Not ButtonDetailsMemory.disabled )
Add2CsvMemory
End If
End Sub
Sub InventoryMonitor( )
Dim arrMonitorDescriptions( ), arrMonitorHardwareIDs( ), arrMonitorManufacturers( ), arrMonitorSerialNumbers( )
Dim blnIsDesktopMonitor
Dim i, intHeight, intIndex, intRow, intWidth, numRatio
Dim colItems, colItems2, objCell, objItem, objItem2, objMatches, objRE, objTable, objTableRow, objWMIService
Dim strDesktopMonitorDeviceDesc, strDesktopMonitorHardwareID, strDesktopMonitorMfg, strDeviceDesc, strInstanceName
Dim strKey, strMfg, strQuery, strQuery2, strSerialNumberID, strSerialNumberLength, strSize
If CheckboxMonitor.Checked Then
On Error Resume Next ' REQUIRED
ButtonDetailsMonitor.disabled = False
' Use Win32_DesktopMonitor to get all the details for 1 monitor only
strQuery = "SELECT * FROM Win32_DesktopMonitor WHERE NOT Description LIKE '%Default%'"
Set objWMIService = GetObject( "winmgmts://" & gvscomputer & "/root/CIMV2" )
Set colItems = objWMIService.ExecQuery( strQuery )
If Not Err Then
For Each objItem In colItems
strDesktopMonitorHardwareID = UCase( objItem.PNPDeviceID )
strDesktopMonitorDeviceDesc = objItem.Description
strDesktopMonitorMfg = objItem.MonitorManufacturer
Next
End If
Set colItems = Nothing
Set objWMIService = Nothing
' Use WmiMonitorID to get some details for all monitors
strQuery = "SELECT * FROM WmiMonitorID"
Set objWMIService = GetObject( "winmgmts://" & gvsComputer & "/root/WMI" )
Set colItems = objWMIService.ExecQuery( strQuery )
If colItems.Count > 0 Then
ReDim arrMonitorDescriptions( colItems.Count - 1 )
ReDim arrMonitorHardwareIDs( colItems.Count - 1 )
ReDim arrMonitorManufacturers( colItems.Count - 1 )
ReDim arrMonitorSerialNumbers( colItems.Count - 1 )
arrMonitorDescriptions(0) = strDesktopMonitorDeviceDesc
arrMonitorHardwareIDs(0) = strDesktopMonitorHardwareID
arrMonitorManufacturers(0) = strDesktopMonitorMfg
intIndex = 1
End If
For Each objItem In colItems
strInstanceName = UCase( objItem.InstanceName )
'strInstanceName = Replace( UCase( Split( objItem.Path_.Path, "=" )(1) ), """", "" ) ' In case the line above doesn't work
blnIsDesktopMonitor = ( InStr( strInstanceName, strDesktopMonitorHardwareID ) = 1 )
If Not blnIsDesktopMonitor Then
' If this is NOT the monitor returned by Win32_DesktopMonitor then we have to query the registry for the Device Description and Manufacturer
' First get the DeviceID as used in the registry by removing a trailing instance index from the InstanceName (e.g. remove "_0" or "_1")
Set objRE = New RegExp
objRE.Pattern = "_\d{1,3}$"
If objRE.Test( strInstanceName ) Then
strInstanceName = objRE.Replace( strInstanceName, "" )
End If
Set objRE = Nothing
arrMonitorHardwareIDs( intIndex ) = strInstanceName
' Read the Device Description from the registry for this monitor
strDeviceDesc = gvoWSHShell.RegRead( "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Enum\" & strInstanceName & "\DeviceDesc" )
If Not IsNull( strDeviceDesc ) Then
If Left( strDeviceDesc, 1 ) <> "(" And InStr( strDeviceDesc, ";" ) > 1 Then
strDeviceDesc = Mid( strDeviceDesc, InStr( strDeviceDesc, ";" ) + 1 )
arrMonitorDescriptions( intIndex ) = strDeviceDesc
End If
End If
' Read the Manufacturer from the registry for this monitor
strMfg = gvoWSHShell.RegRead( "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Enum\" & strInstanceName & "\Mfg" )
If Not IsNull( strMfg ) Then
If Left( strMfg, 1 ) <> "(" And InStr( strMfg, ";" ) > 1 Then
strMfg = Mid( strMfg, InStr( strMfg, ";" ) + 1 )
arrMonitorManufacturers( intIndex ) = strMfg
End If
End If
End If
strSerialNumberLength = objItem.UserFriendlyNameLength
If gvaSettingsBool.Item( "DEVTEST" ) Then
strSerialNumberID = GetRandomString( strSerialNumberLength )
ElseIf strSerialNumberLength > 0 Then
strSerialNumberID = Chain( objItem.SerialNumberID )
Else
strSerialNumberID = ""
End If
If blnIsDesktopMonitor Then
arrMonitorSerialNumbers(0) = strSerialNumberID
Else
arrMonitorSerialNumbers( intIndex ) = strSerialNumberID
End If
' Get monitor dimensions for this monitor
strQuery2 = "SELECT * FROM WmiMonitorBasicDisplayParams WHERE InstanceName LIKE '" & Replace( strInstanceName, "\", "\\" ) & "%'"
Set colItems2 = objWMIService.ExecQuery( strQuery2 )
If Not Err Then
If colItems2.Count = 1 Then
For Each objItem2 in colItems2
intHeight = objItem2.MaxVerticalImageSize
intWidth = objitem2.MaxHorizontalImageSize
If intHeight * intWidth > 0 Then
numRatio = intWidth / intHeight
If gvaSettingsBool.Item( "CM" ) Then
strSize = " (" & intWidth & " x " & intHeight & " cm"
Else
strSize = " (" & CInt( Sqr( ( intWidth * intWidth ) + ( intHeight * intHeight ) ) / 2.54 ) & """"
End If
If numRatio >= 1.45 Then
strSize = strSize & " widescreen"
End If
strSize = strSize & ")"
arrMonitorDescriptions( intIndex ) = arrMonitorDescriptions( intIndex ) & strSize
End If
Next
End If
End If
Next
If UBound( arrMonitorDescriptions ) >= 0 Then
document.getElementById( "MultipleMonitors" ).style.display = "inline"
MonitorIndex0.value = 0
MonitorModel0.value = arrMonitorDescriptions(0)
MonitorManufacturer0.value = arrMonitorManufacturers(0)
MonitorSerial0.value = arrMonitorSerialNumbers(0)
If UBound( arrMonitorDescriptions ) > 0 Then
Set objTable = document.getElementById( "Results" )
intRow = document.getElementById( "Monitor0" ).rowIndex
For i = 1 To UBound( arrMonitorDescriptions )
Set objTableRow = objTable.insertRow( intRow + i )
objTableRow.id = "Monitor" & i
Set objCell = objTableRow.insertCell( 0 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 1 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 2 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 3 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 4 )
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""MonitorIndex" & i & """ size=""12"" value=""" & i & """ readonly />"
Set objCell = objTableRow.insertCell( 5 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 6 )
objcell.setAttribute "colSpan", 3
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""MonitorModel" & i & """ size=""40"" value=""" & arrMonitorDescriptions(i) & """ readonly />"
Set objCell = objTableRow.insertCell( 7 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 8 )
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""MonitorManufacturer" & i & """ size=""16"" value=""" & arrMonitorManufacturers(i) & """ readonly />"
Set objCell = objTableRow.insertCell( 9 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 10 )
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""MonitorSerial" & i & """ size=""16"" value=""" & arrMonitorSerialNumbers(i) & """ readonly />"
Set objCell = Nothing
Set objTableRow = Nothing
Next
Set objTable = Nothing
End If
End If
DebugMessage "", "Monitor inventory succeeded: " & CStr( Not ButtonDetailsMonitor.disabled )
On Error Goto 0
End If
End Sub
Sub InventoryMouse( )
Dim arrConnectorTypes, arrDeviceInterfaces, arrHardwareTypes, arrPointingTypes
Dim intButtons, intConnectorType, intCount, intMouseType
Dim colItems, objItem
Dim strConnectorType, strMouseModel, strMouseType
If CheckboxMouse.checked Then
' Enumeration of connector and hardware types
arrConnectorTypes = Array( "PS/2", "Serial","USB" )
arrHardwareTypes = Array( "Standard Mouse", "Standard Pointer", "Standard Absolute Pointer", "Tablet", "Touch Screen", "Pen", "Track Ball" )
ReDim Preserve arrHardwareTypes( 256 )
arrHardwareTypes( 256 ) = "Other"
arrPointingTypes = Array( "Unknown", "Other", "Unknown", "Mouse", "Trackball", "Track Point", "Glide Point", "Touch Pad", "Touch Screen", "Mouse - Optical Sensor" )
arrDeviceInterfaces = Array( "Unknown", "Other", "Unknown", "Serial", "PS/2", "Infrared", "HP-HIL", "Bus mouse", "ADB (Apple Desktop Bus)" )
ReDim Preserve arrDeviceInterfaces( 162 )
arrDeviceInterfaces( 160 ) = "Bus mouse DB-9"
arrDeviceInterfaces( 161 ) = "Bus mouse micro-DIN"
arrDeviceInterfaces( 162 ) = "USB"
On Error Resume Next ' REQUIRED
' Check for mouse details in root/CIMV2 - this is not likely to fail on access denied errors
intCount = 0
Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_PointingDevice" )
If Not Err Then
intCount = colItems.Count
If intCount > 1 Then
Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_PointingDevice WHERE NOT PNPDeviceID LIKE 'ACPI\\%'" )
intCount = colItems.Count
If colItems.Count = 0 Then
Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_PointingDevice" )
End If
End If
For Each objItem In colItems
intButtons = objItem.NumberOfButtons
intMouseType = objItem.PointingType
strMouseType = arrPointingTypes( intMouseType )
intConnectorType = objItem.DeviceInterface
strConnectorType = arrDeviceInterfaces( intConnectorType )
strMouseModel = objItem.Description
MouseButtons.value = intButtons
MouseType.value = strMouseType
MouseModel.value = strMouseModel
MouseConn.value = strConnectorType
Next
ButtonDetailsMouse.disabled = False
End If
' Check for additional mouse details in root/WMI - this may fail on access denied errors when not running with elevated privileges
intCount = 0
Set colItems = gvoWMIrootWMI.ExecQuery( "SELECT * FROM MSMouse_PortInformation WHERE Active = True" )
If Not Err Then
intCount = colItems.Count
If intCount > 1 Then
Set colItems = gvoWMIrootWMI.ExecQuery( "SELECT * FROM MSMouse_PortInformation WHERE Active = True AND Instancename LIKE 'HID\\%'" )
intCount = colItems.Count
If intCount = 0 Then
Set colItems = gvoWMIrootWMI.ExecQuery( "SELECT * FROM MSMouse_PortInformation WHERE Active = True AND Instancename LIKE '%&%'" )
End If
End If
For Each objItem In colItems
intButtons = objItem.Buttons
intButtons = Max( MouseButtons.value, intButtons )
If Not gvbIsElevated And intButtons = 0 Then
' If not running with elevated privileges, this field contains nonsense
MouseButtonsHeader.style.visibility = "hidden"
MouseButtons.style.visibility = "hidden"
Else
MouseButtonsHeader.style.visibility = "visible"
MouseButtons.style.visibility = "visible"
MouseButtons.value = intButtons
End If
intConnectorType = objItem.ConnectorType
strConnectorType = arrConnectorTypes( intConnectorType )
strMouseModel = MouseModel.value
MouseModel.value = strMouseModel
MouseConn.value = strConnectorType
Next
ButtonDetailsMouse.disabled = False
End If
On Error Goto 0
DebugMessage "", "Mouse inventory succeeded: " & CStr( Not ButtonDetailsMouse.disabled )
Add2CsvMouse
End If
End Sub
Sub InventoryNIC( )
Dim arrNICPhysicalMedia(19)
Dim i, intIndex, intRandom, intRow
Dim colItems, objCell, objItem, objMACAddresses, objNICPhysMedia, objNICProductNames, objNICSpeeds, objTable, objTableRow
Dim strKey, strMACAddress, strQuery, strSpeed
arrNICPhysicalMedia( 0 ) = "Unspecified"
arrNICPhysicalMedia( 1 ) = "Wireless LAN"
arrNICPhysicalMedia( 2 ) = "Cable Modem"
arrNICPhysicalMedia( 3 ) = "Phone Line"
arrNICPhysicalMedia( 4 ) = "Power Line"
arrNICPhysicalMedia( 5 ) = "DSL"
arrNICPhysicalMedia( 6 ) = "FC"
arrNICPhysicalMedia( 7 ) = "1394"
arrNICPhysicalMedia( 8 ) = "Wireless WAN"
arrNICPhysicalMedia( 9 ) = "Native 802.11"
arrNICPhysicalMedia( 10 ) = "BlueTooth"
arrNICPhysicalMedia( 11 ) = "Infiniband"
arrNICPhysicalMedia( 12 ) = "WiMAX"
arrNICPhysicalMedia( 13 ) = "UWB"
arrNICPhysicalMedia( 14 ) = "802.3"
arrNICPhysicalMedia( 15 ) = "802.5"
arrNICPhysicalMedia( 16 ) = "IRDA"
arrNICPhysicalMedia( 17 ) = "Wired WAN"
arrNICPhysicalMedia( 18 ) = "Wired Connection Oriented WAN"
arrNICPhysicalMedia( 19 ) = "Other"
If CheckBoxNIC.Checked Then
On Error Resume Next ' REQUIRED
strQuery = "SELECT * FROM MSFT_NetAdapter"
Set colItems = gvoWMIrootStandardCimv2.ExecQuery( strQuery )
If Not Err Then
Set objMACAddresses = CreateObject( "System.Collections.Sortedlist" )
Set objNICProductNames = CreateObject( "System.Collections.Sortedlist" )
Set objNICSpeeds = CreateObject( "System.Collections.Sortedlist" )
Set objNICPhysMedia = CreateObject( "System.Collections.Sortedlist" )
intIndex = 0
For Each objItem In colItems
If gvaSettingsBool.Item( "DEVTEST" ) Then
strMACAddress = ""
For i = 1 To 16
intRandom = gvoRandom.Next_2( 48, 63 )
If intRandom > 57 Then intRandom = intRandom + 7
strMACAddress = strMACAddress + Chr( intRandom )
Next
objMACAddresses.Item( intIndex ) = strMACAddress
Else
objMACAddresses.Item( intIndex ) = objItem.PermanentAddress
End If
objNICProductNames.Item( intIndex ) = objItem.DriverDescription
objNICSpeeds.Item( intIndex ) = objItem.Speed
If objNICSpeeds.Item( intIndex ) >= 1000000000 Then
strSpeed = " (" & ( objNICSpeeds.Item( intIndex ) / 1000000000 ) & " Gb/s)"
ElseIf objNICSpeeds.Item( intIndex ) >= 1000000 Then
strSpeed = " (" & ( objNICSpeeds.Item( intIndex ) / 1000000 ) & " Mb/s)"
ElseIf objNICSpeeds.Item( intIndex ) >= 1000 Then
strSpeed = " (" & ( objNICSpeeds.Item( intIndex ) / 1000 ) & " kb/s)"
Else
strSpeed = ""
End If
objNICSpeeds.Item( intIndex ) = objNICSpeeds.Item( intIndex ) & strSpeed
objNICPhysMedia.Item( intIndex ) = arrNICPhysicalMedia( objItem.NdisPhysicalMedium )
intIndex = intIndex + 1
Next
strKey = objMACAddresses.GetKey( 0 )
NICIndex0.value = strKey
NICModel0.value = objNICProductNames.Item( strKey ) & " (" & objNICPhysMedia.Item( strKey ) & ")"
MACAddress0.value = objMACAddresses.Item( strKey )
NICSpeed0.value = objNICSpeeds.Item( strKey )
If objMACAddresses.Count > 1 Then
MultipleNICs.style.display = "inline"
Set objTable = document.getElementById( "Results" )
intRow = document.getElementById( "NIC0" ).rowIndex
For i = 1 To objMACAddresses.Count - 1
strKey = objMACAddresses.GetKey( i )
Set objTableRow = objTable.insertRow( intRow + i )
objTableRow.id = "NIC" & i
Set objCell = objTableRow.insertCell( 0 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 1 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 2 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 3 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 4 )
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""NICIndex" & i & """ size=""12"" value=""" & strKey & """ readonly />"
Set objCell = objTableRow.insertCell( 5 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 6 )
objcell.setAttribute "colSpan", 3
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""NICModel" & i & """ size=""40"" value=""" & objNICProductNames.Item( strKey ) & " (" & objNICPhysMedia.Item( strKey ) & ")"" readonly />"
Set objCell = objTableRow.insertCell( 7 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 8 )
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""MACAddress" & i & """ size=""16"" value=""" & objMACAddresses.Item( strKey ) & """ readonly />"
Set objCell = objTableRow.insertCell( 9 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 10 )
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""NICSpeed" & i & """ size=""16"" value=""" & objNICSpeeds.Item( strKey ) & """ readonly />"
Set objCell = Nothing
Set objTableRow = Nothing
Next
End If
Set objtable = Nothing
Set objMACAddresses = Nothing
Set objNICProductNames = Nothing
Set objNICSpeeds = Nothing
ButtonDetailsNIC.disabled = False
End If
On Error Goto 0
DebugMessage "", "NIC inventory succeeded: " & CStr( Not ButtonDetailsNIC.disabled )
Add2CsvNIC
End If
End Sub
Sub InventoryPorts( )
Dim cntAGP, cntFireWire, cntOther, cntParallel, cntPCI, cntPCIE, cntSerial, cntUSB, cntUSB3, colItems, objItem
cntAGP = 0
cntFireWire = 0
cntOther = 0
cntParallel = 0
cntPCI = 0
cntPCIE = 0
cntSerial = 0
cntUSB = 0
cntUSB3 = 0
If CheckBoxPorts.Checked Then
On Error Resume Next ' REQUIRED
' Check for USB controllers
Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_USBController" )
If Not Err Then cntUSB = colItems.Count
Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_USBController WHERE Name LIKE '%USB 3%'" )
If Not Err Then
cntUSB3 = colItems.Count
cntUSB = cntUSB - cntUSB3
ButtonDetailsPorts.disabled = False
End If
If cntUSB3 > 0 Then
USB.value = cntUSB & " + " & cntUSB3 & " x USB3"
Else
USB.value = cntUSB
End If
' Count FireWire ports
Set colItems = gvoWMIrootCimv2.Execquery( "SELECT * FROM Win32_1394ControllerDevice" )
If Not Err Then
cntFireWire = colItems.Count
ButtonDetailsPorts.disabled = False
End If
FireWire.value = cntFireWire
' Count parallel ports
Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_ParallelPort" )
If Not Err Then
cntParallel = colItems.Count
ButtonDetailsPorts.disabled = False
End If
' Count serial ports
Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_SerialPort" )
If Not Err Then
cntSerial = colItems.Count
ButtonDetailsPorts.disabled = False
End If
If cntParallel > 0 And cntSerial > 0 Then
Legacy.value = cntParallel & "x Parallel, " & cntSerial & "x Serial"
ElseIf cntSerial > 0 Then
Legacy.value = cntSerial & " Serial"
ElseIf cntParallel > 0 Then
Legacy.value = cntParallel & " Parallel"
Else
Legacy.value = 0
End If
' Count system slots (PCI/AGP)
Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT SlotDesignation FROM Win32_SystemSlot" )
If Not Err Then
For Each objItem In colItems
If Left( objItem.SlotDesignation, 3 ) = "AGP" Then cntAGP = cntAGP + 1
If Left( objItem.SlotDesignation, 3 ) = "PCI" Then
If Left( objItem.SlotDesignation, 4 ) = "PCIE" Then
cntPCIE = cntPCIE + 1
Else
cntPCI = cntPCI + 1
End If
End If
If InStr( "AGPCI", Left( objItem.SlotDesignation, 3 ) ) = 0 Then cntOther = cntOther + 1
Next
ButtonDetailsPorts.disabled = False
End If
On Error Goto 0
Slots.value = cntPCI & " x PCI, " & cntPCIE & " x PCIE, " & cntAGP & " x AGP"
gvsSlots = cntPCI & "xPCI " & cntPCIE & "xPCIE " & cntAGP & "xAGP"
If cntOther > 0 Then
Slots.value = Slots.value & ", " & cntOther & " x Other"
gvsSlots = gvsSlots & " " & cntOther & "xOther"
End If
DebugMessage "", "Ports inventory succeeded: " & CStr( Not ButtonDetailsPorts.disabled )
Add2CsvPorts
End If
End Sub
Sub InventorySound( )
Dim arrSubKeys, arrSubSubKeys, arrSubSubSubKeys
Dim blnRegValFound
Dim i, j, k
Dim colItems, objItem, objReg
Dim strDescription, strQuery
If CheckBoxSound.Checked Then
' First search the registry for the ACTIVE sound card: it should have a key
' like "HKLM\SYSTEM\CurrentControlSet\Enum\HDAUDIO\FUNC_*\*\Device Parameters\"
' and then its name can be found at the end of the string value
' "HKLM\SYSTEM\CurrentControlSet\Enum\HDAUDIO\FUNC_*\*\DeviceDesc"
' after the last semicolon
blnRegValFound = True
Set objReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!//" & gvsComputer & "/root/default:StdRegProv" )
blnRegValFound = blnRegValFound And objReg.EnumKey( HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Enum\HDAUDIO", arrSubKeys )
For i = 0 To UBound( arrSubKeys )
blnRegValFound = blnRegValFound And objReg.EnumKey( HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Enum\HDAUDIO\" & arrSubKeys(i), arrSubSubKeys )
For j = 0 To UBound( arrSubSubKeys )
blnRegValFound = blnRegValFound And objReg.EnumKey( HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Enum\HDAUDIO\" & arrSubKeys(i) & "\" & arrSubSubKeys(j), arrSubSubSubKeys )
For k = 0 To UBound( arrSubSubSubKeys )
If arrSubSubSubKeys(k) = "Device Parameters" Then
blnRegValFound = blnRegValFound And objReg.GetStringValue( HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Enum\HDAUDIO\" & arrSubKeys(i) & "\" & arrSubSubKeys(j), "DeviceDesc", strDescription )
End If
Next
Next
Next
strDescription = Mid( strDescription, InStrRev( strDescription, ";" ) + 1 )
Set objReg = Nothing
On Error Resume Next ' REQUIRED
strQuery = "SELECT * FROM Win32_SoundDevice"
' Append the name of the ACTIVE sound card, if found, to the query
If blnRegValFound Then strQuery = strQuery & " WHERE Name=""" & strDescription & """"
Set colItems = gvoWMIrootCimv2.ExecQuery( strQuery )
If Err Or IsNull( colItems ) Or colItems.Count = 0 Then
If gvbWinPE And gvsWinDrive <> "" Then InventorySoundWinPE
Else
For Each objItem In colItems
SoundCardManufacturer.value = objItem.Manufacturer
SoundCardModel.value = objItem.ProductName
Next
ButtonDetailsSound.disabled = False
End If
On Error Goto 0
DebugMessage "", "Sound Devices inventory succeeded: " & CStr( Not ButtonDetailsSound.disabled )
Add2CsvSound
End If
End Sub
Sub InventorySoundWinPE( )
Dim arrRegKeys, arrSubKeys, arrSubSubKeys, arrTest
Dim blnFoundHardwareManufacturer
Dim i
Dim dicSoundCards, objReg
Dim strAudioDescription, strAudioManufacturer, strKey, strRegKey, strSubKey
' Mount registry hive from Windows Drive
gvoWSHShell.Run "CMD.EXE /C REG.EXE Load HKLM\TempHive " & gvsWinDrive & "\windows\system32\config\system", 0, True
' Scan the temporary registry hive for sound cards
Set dicSoundCards = CreateObject( "Scripting.Dictionary" )
Set objReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!//./root/default:StdRegProv" )
objReg.EnumKey HKEY_LOCAL_MACHINE, "TempHive\ControlSet001\Enum\HDAudio", arrRegKeys
If Not IsNull( arrRegKeys ) Then
For Each strRegKey In arrRegKeys
objReg.EnumKey HKEY_LOCAL_MACHINE, "TempHive\ControlSet001\Enum\HDAudio\" & strRegKey, arrSubKeys
If Not IsNull( arrSubKeys ) Then
For Each strSubKey In arrSubKeys
objReg.Enumkey HKEY_LOCAL_MACHINE, "TempHive\ControlSet001\Enum\HDAudio\" & strRegKey & "\" & strSubKey, arrSubSubKeys
If Not IsNull( arrSubSubKeys ) Then
strAudioDescription = Null
strAudioManufacturer = Null
objReg.GetStringValue HKEY_LOCAL_MACHINE, "TempHive\ControlSet001\Enum\HDAudio\" & strRegKey & "\" & strSubKey, "DeviceDesc", strAudioDescription
objReg.GetStringValue HKEY_LOCAL_MACHINE, "TempHive\ControlSet001\Enum\HDAudio\" & strRegKey & "\" & strSubKey, "Mfg", strAudioManufacturer
If Not IsNull( strAudioDescription ) And Not IsNull( strAudioManufacturer ) Then
If InStr( strAudioDescription, ";" ) Then
arrTest = Split( strAudioDescription, ";" )
strAudioDescription = arrTest( UBound( arrTest ) )
End If
If InStr( strAudioManufacturer, ";" ) Then
arrTest = Split( strAudioManufacturer, ";" )
strAudioManufacturer = arrTest( UBound( arrTest ) )
End If
dicSoundCards.Item( Trim( strAudioManufacturer ) ) = Trim( strAudioDescription )
End If
End If
Next
End If
Next
End If
Set objReg = Nothing
' Unmount registry hive
gvoWSHShell.Run "CMD.EXE /C REG.EXE Unload HKLM\TempHive", 0, True
' Search the results, preferably for a true hardware manufacturer
strAudioDescription = ""
strAudioManufacturer = ""
blnFoundHardwareManufacturer = False
For Each strKey in dicSoundCards.Keys
If UCase( strKey ) <> "MICROSOFT" Then
strAudioManufacturer = strKey
strAudioDescription = dicSoundCards.Item( strKey )
blnFoundHardwareManufacturer = True
End If
Next
If Not blnFoundHardwareManufacturer Then
For Each strKey in dicSoundCards.Keys
strAudioManufacturer = strKey
strAudioDescription = dicSoundCards.Item( strKey )
Next
End If
Set dicSoundCards = Nothing
SoundCardManufacturer.value = strAudioManufacturer
SoundCardModel.value = strAudioDescription
ButtonDetailsSound.disabled = Not blnFoundHardwareManufacturer
DebugMessage "", "Sound Devices inventory succeeded: " & CStr( Not ButtonDetailsSound.disabled )
End Sub
Sub InventoryVideo( )
Dim arrVideoMemories( ), arrVideoModels( ), arrVideoModes( )
Dim i, intIndex, intRow, intVidMem
Dim colItems, objCell, objItem, objReg, objTable, objTableRow
If CheckboxVideo.Checked Then
On Error Resume Next ' REQUIRED
' WHERE clauses to exclude Citrix or other virtual video devices, based on input by Steve Robertson
Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_VideoController WHERE AdapterRAM IS NOT NULL AND InstalledDisplayDrivers IS NOT NULL" )
If Err Or IsNull( colItems ) Or colItems.Count = 0 Then
If gvbWinPE And gvsWinDrive <> "" Then
On Error Goto 0
ButtonDetailsVideo.disabled = True
InventoryVideoWinPE
End If
Else
ReDim arrVideoMemories( colItems.Count - 1 )
ReDim arrVideoModels( colItems.Count - 1 )
ReDim arrVideoModes( colItems.Count - 1 )
intIndex = 0
intVidMem = 0
For Each objItem in colItems
arrVideoMemories( intIndex ) = Round( objItem.AdapterRAM / MB )
arrVideoModels( intIndex ) = objItem.Name
arrVideoModes( intIndex ) = objItem.VideoModeDescription
' Correct video RAM if 4GB or more and for internal devices
intVidMem = GetVideoRAM( arrVideoModels( intIndex ) )
If intVidMem > 0 Then
arrVideoMemories( intIndex ) = intVidMem
End If
intIndex = intIndex + 1
Next
VideoIndex0.value = 0
VideoModel0.value = arrVideoModels(0)
VideoMemory0.value = arrVideoMemories(0)
VideoMode0.value = arrVideoModes(0)
If UBound( arrVideoModels ) > 0 Then
Set objTable = document.getElementById( "Results" )
intRow = document.getElementById( "Video0" ).rowIndex
For i = 1 To UBound( arrVideoModels )
Set objTableRow = objTable.insertRow( intRow + i )
objTableRow.id = "Video" & i
Set objCell = objTableRow.insertCell( 0 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 1 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 2 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 3 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 4 )
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""VideoIndex" & i & """ size=""12"" value=""" & i & """ readonly />"
Set objCell = objTableRow.insertCell( 5 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 6 )
objCell.setAttribute "colSpan", 3
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""VideoModel" & i & """ size=""40"" value=""" & arrVideoModels(i) & """ readonly />"
Set objCell = objTableRow.insertCell( 7 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 8 )
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""VideoMemory" & i & """ size=""16"" value=""" & arrVideoMemories(i) & """ readonly />"
Set objCell = objTableRow.insertCell( 9 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 10 )
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""VideoMode" & i & """ size=""16"" value=""" & arrVideoModes(i) & """ readonly />"
Set objCell = Nothing
Set objTableRow = Nothing
Next
End If
Set objTable = Nothing
ButtonDetailsVideo.disabled = False
End If
DebugMessage "", "Video inventory succeeded: " & CStr( Not ButtonDetailsVideo.disabled )
On Error Goto 0
End If
End Sub
Sub InventoryVideoWinPE( )
Dim arrRegKeys, arrSubKeys
Dim i, intIndex, intRow
Dim dicVideoCards, objCell, objReg, objtable, objTableRow
Dim strDictKey, strRegKey, strVideoDescription, strVideoService
' Mount registry hive from Windows Drive
gvoWSHShell.Run "CMD.EXE /C REG.EXE Load HKLM\TempHive " & gvsWinDrive & "\windows\system32\config\system", 0, True
' Scan the temporary registry hive for video cards
Set dicVideoCards = CreateObject( "Scripting.Dictionary" )
Set objReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!//./root/default:StdRegProv" )
objReg.EnumKey HKEY_LOCAL_MACHINE, "TempHive\ControlSet001\Control\Video", arrRegKeys
If Not IsNull( arrRegKeys ) Then
For Each strRegKey In arrRegKeys
objReg.GetStringValue HKEY_LOCAL_MACHINE, "TempHive\ControlSet001\Control\Video\" & strRegKey & "\Video", "Service", strVideoService
If strVideoService <> "" And UCase( strVideoService ) <> "VGA" Then ' Ignore standard VGA driver
objReg.GetStringValue HKEY_LOCAL_MACHINE, "TempHive\ControlSet001\Services\" & strVideoService & "\Device0", "Device Description", strVideoDescription
If Left( strVideoDescription, 3 ) <> "RDP" Then ' Ignore RDP video drivers
dicVideoCards.Item( strVideoService ) = strVideoDescription
End If
End If
Next
End If
' Unmount registry hive
gvoWSHShell.Run "CMD.EXE /C REG.EXE Unload HKLM\TempHive", 0, True
VideoIndex0.value = 0
VideoModel0.value = dicVideoCards.Item(0)
VideoMemory0.value = "?"
VideoMode0.value = "?"
If dicVideoCards.Count > 1 then
Set objTable = document.getElementById( "Results" )
intRow = document.getElementById( "Video0" ).rowIndex
For i = 1 To dicVideoCards.Count - 1
strDictKey = dicVideoCards.Keys(i)
Set objTableRow = objTable.insertRow( intRow + i )
objTableRow.id = "Video" & i
Set objCell = objTableRow.insertCell( 0 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 1 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 2 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 3 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 4 )
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""VideoIndex" & i & """ size=""12"" value=""" & i & """ readonly />"
Set objCell = objTableRow.insertCell( 5 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 6 )
objcell.setAttribute "colSpan", 3
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""VideoModel" & i & """ size=""40"" value=""" & dicVideoCards.Item( strDictKey ) & """ readonly />"
Set objCell = objTableRow.insertCell( 7 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 8 )
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""VideoMemory" & i & """ size=""16"" value=""?"" readonly />"
Set objCell = objTableRow.insertCell( 9 )
objCell.innerHTML = " "
Set objCell = objTableRow.insertCell( 10 )
objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""VideoMode" & i & """ size=""16"" value=""?"" readonly />"
Set objCell = Nothing
Set objTableRow = Nothing
ButtonDetailsVideo.disabled = True
Next
End If
Set objReg = Nothing
Set dicVideoCards = Nothing
DebugMessage "", "Video inventory succeeded: " & CStr( Not ButtonDetailsVideo.disabled )
End Sub
Sub InventoryWinSATScores( )
Dim colItems, objItem
sngCPU = -1
sngDisk = -1
sngMemory = -1
sngTotal = -1
sngVideo = -1
If Not gvaSettingsBool.Item( "NOSCORES" ) And Not gvbWinPE Then
On Error Resume Next ' REQUIRED
Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_WinSAT Where TimeTaken=""MostRecentAssessment""" )
If Not Err Then
For Each objItem in colItems
sngCPU = objItem.CPUScore
sngDisk = objItem.DiskScore
sngVideo = objItem.GraphicsScore
sngMemory = objItem.MemoryScore
sngTotal = objItem.WinSPRLevel
Next
End If
If CheckboxCPU.Checked Then CPUScore.value = sngCPU
If CheckboxHDD.Checked Then DiskScore.value = sngDisk
If CheckboxMainBoard.Checked Then WinSATScore.value = sngTotal
If CheckboxMemory.Checked Then MemoryScore.value = sngMemory
If CheckboxVideo.Checked Then GraphicsScore.value = sngVideo
On Error Goto 0
If sngCPU < 1 Then
MsgBox "If WinSAT scores remain empty, run the command ""winsat.exe formal"" once in an elevated console.", vbOKOnly + vbInformation, "Enable WinSAT scores"
End If
End If
DebugMessage "", "WinSat scores inventory succeeded: " & CStr( CBool( sngCPU > -1 ) )
Set colItems = Nothing
End Sub
Function IsAdmin( showMessage )
' Based on code by Denis St-Pierre
Dim intAnswer, intButtons, intPlatformHTA, intPlatformWin, intRC
Dim colItems, objItem, objUAC
Dim strCommandLine, strHTA, strMsg, strTitle
gvbIsElevated = False
On Error Resume Next ' REQUIRED
gvbIsElevated = ( gvoWSHShell.Run( "CMD /C OPENFILES > NUL 2>&1", 7, True ) = 0 )
If Err Then intRC = 1
On Error Goto 0
If ( InStr( UCase( Hardware.CommandLine ), "/NOADMIN" ) > 0 ) Or gvbWinPE Then
IsAdmin = True
Else
IsAdmin = False
intPlatformHTA = CInt( Right( window.navigator.platform, 2 ) )
If gvoFSO.FolderExists( gvoWSHShell.ExpandEnvironmentStrings( "%windir%\SysWOW64" ) ) Then
intPlatformWin = 64
Else
intPlatformWin = 32
End If
If gvbIsElevated Then
intRC = 0
IsAdmin = True
Else
intRC = 1
If showMessage Then
strTitle = "Elevated Privileges Recommended"
intButtons = vbYesNoCancel + vbInformation + vbApplicationModal
strMsg = "This HTA works best with elevated privileges." & vbCrLf _
& "Without elevated privileges, the HTA won't have access to all WMI namespaces, i.e. some details will be missed." & vbCrLf & vbCrLf _
& "Running this HTA as administrator is recommended." & vbCrLf & vbCrLf & vbCrLf & vbcrlf
If intPlatformHTA = 32 And intPlatformWin = 64 Then
strMsg = strMsg _
& "This HTA is running in a 32-bit MSHTA process (%windir%\SysWOW64\mshta.exe) on 64-bit Windows." & vbCrLf & vbCrLf _
& "Add the path to the proper (64-bit) MSHTA to this HTA's command line:" & vbCrLf & vbCrLf
Else
strMsg = strMsg _
& "Note: On some 64-bit systems, you may still get this message, whether running with elevated privileges or not." & vbCrLf & vbCrLf _
& "Usually this is caused by HTAs being incorrectly associated with the 32-bit MSHTA version (%windir%\SysWOW64\mshta.exe)." & vbCrLf & vbCrLf _
& "In that case, either use the ""/NOADMIN"" command line switch, or add the path to the proper (64-bit) MSHTA to this HTA's command line:" & vbCrLf & vbCrLf
End If
strMsg = strMsg _
& """%windir%\system32\mshta.exe"" """
If InStr( UCase( Hardware.CommandLine ), "/DEVTEST" ) Then
strMsg = strMsg & "C:\Scripts\Hardware.hta"
Else
strMsg = strMsg & Self.location.pathname
End if
strMsg = strMsg _
& """" & vbCrLf & vbCrLf & vbCrLf & vbCrLf _
& "Do you want to elevate privileges now?" & vbCrLf & vbCrLf _
& "Yes:" & vbtab & "Restart the HTA with elevated privileges" & vbCrLf _
& "No:" & vbTab & "Continue without elevated privileges" & vbCrLf _
& "Cancel:" & vbTab & "Abort"
intAnswer = MsgBox( strMsg, intButtons, strTitle )
If intAnswer = vbYes Then
strHTA = Self.location.pathname
strCommandLine = Hardware.CommandLine
' Strip HTA file name or path from command line
If InStr( strCommandLine, """" & strHTA & """" ) = 1 Then
strCommandLine = Mid( strCommandLine, Len( strHTA ) + 3 )
ElseIf InStr( strCommandLine, strHTA ) = 1 Then
strCommandLine = Mid( strCommandLine, Len( strHTA ) + 1 )
ElseIf InStr( strCommandLine, """" & gvoFSO.GetFileName( strHTA ) & """" ) = 1 Then
strCommandLine = Mid( strCommandLine, Len( strHTA ) + 3 )
ElseIf InStr( strCommandLine, gvoFSO.GetFileName( strHTA ) ) = 1 Then
strCommandLine = Mid( strCommandLine, Len( strHTA ) + 1 )
ElseIf InStr( strCommandLine, gvoFSO.GetFileName( strHTA ) ) > 0 Then
strCommandLine = Mid( strCommandLine, InStr( strHTA ) + Len( strHTA ) + 1 )
If Left( strCommandLine, 1 ) = """" Then strCommandLine = Mid( strCommandLine, 2 )
Else
' Error: do nothing, the HTA will close
End If
strCommandLine = Replace( Trim( strCommandLine ), """", """""" )
If InStr( UCase( strCommandLine ), "/TEMPDIR:" ) = -1 Then
strCommandLine = "/TEMPDIR:""" & gvaSettingsStr.Item( "TEMPDIR" ) & """ " & strCommandLine
End If
If InStr( UCase( strCommandLine ), "/NOADMIN" ) = -1 Then
strCommandLine = "/NOADMIN " & strCommandLine
End If
' If we don't have elevated privileges yet, and Chrome is the default browser, make sure Chrome is active before elevating this HTA's privileges.
' Failing to do so will block Chrome from opening new unelevated tabs or windows after the first elevated window is opened.
If Not gvbIsElevated And InStr( UCase( gvsDefaultBrowserName ), "CHROME" ) Then
Set colItems = gvoWMIlocalCimv2.ExecQuery( "SELECT * FROM Win32_Process WHERE ExecutablePath='" & Replace( gvsDefaultBrowserPath, "\", "\\" ) & "'" )
If colItems.Count = 0 Then
gvoWSHShell.Run """" & gvsDefaultBrowserPath & """", 7, False
End If
Set colItems = Nothing
End If
' Elevate privileges
Set objUAC = CreateObject( "Shell.Application" )
objUAC.ShellExecute "MSHTA.EXE", """" & strHTA & """ " & strCommandLine, "", "runas", 1
Set objUAC = Nothing
window.close True
ElseIf intAnswer = vbNo Then
IsAdmin = True
End If
End If
End If
On Error GoTo 0
End If
End Function
Function IsLocalComputer( )
' Check if specified computer is the local computer
IsLocalComputer = False
gvsComputer = CheckComputerName( ComputerName.value )
If gvsComputer = "" Then Exit Function
If gvbWinPE Then
IsLocalComputer = True
gvaSettingsBool.Item( "DXDIAG" ) = False
gvaSettingsBool.Item( "DMIDECODE" ) = False
ElseIf ( gvsComputer = GetLocalComputerName( ) ) Or ( gvsComputer = "LOCALHOST" ) Or ( gvsComputer = "127.0.0.1" ) Or ( gvsComputer = "::1" ) Then
IsLocalComputer = True
gvaSettingsStr.Item( "COMPUTER" ) = gvsComputer
Else
IsLocalComputer = False
gvaSettingsBool.Item( "DXDIAG" ) = False
gvaSettingsBool.Item( "DMIDECODE" ) = False
gvaSettingsStr.Item( "COMPUTER" ) = gvsComputer
End If
ConfigUpdateStatus
End Function
Sub ListColors( myDropdown, myPreselected )
' Populate a dropdown list with colors available in CSS
Dim i, objDropdown, objOption, strColor
Set objDropdown = document.getElementById( myDropdown )
objDropdown.innerHTML = ""
On Error Resume Next ' REQUIRED
For Each strColor In gvaCSSColors.Keys
Set objOption = document.createElement( "OPTION" )
objOption.text = strColor
objOption.value = LCase( strColor )
objOption.selected = ( LCase( myPreselected ) = LCase( strColor ) )
objOption.style.backgroundColor = LCase( strColor )
objOption.style.color = gvaCSSColors.Item( strColor )
If Not Err Then objDropdown.Add( objOption )
Set objOption = Nothing
Next
On Error Goto 0
Set objDropdown = Nothing
End Sub
Sub ListCSSColors( )
' List of available CSS colors by W3Schools.com:
' http://www.w3schools.com/colors/colors_names.asp
' Contrasting text colors calculated with code by Brian Suda:
' https://24ways.org/2010/calculating-color-contrast/
On Error Resume Next ' REQUIRED
Set gvaCSSColors = Nothing
On Error Goto 0
Set gvaCSSColors = CreateObject( "Scripting.Dictionary" )
gvaCSSColors.Item( "AliceBlue" ) = "black"
gvaCSSColors.Item( "AntiqueWhite" ) = "black"
gvaCSSColors.Item( "Aqua" ) = "black"
gvaCSSColors.Item( "Aquamarine" ) = "black"
gvaCSSColors.Item( "Azure" ) = "black"
gvaCSSColors.Item( "Beige" ) = "black"
gvaCSSColors.Item( "Bisque" ) = "black"
gvaCSSColors.Item( "Black" ) = "white"
gvaCSSColors.Item( "BlanchedAlmond" ) = "black"
gvaCSSColors.Item( "Blue" ) = "white"
gvaCSSColors.Item( "BlueViolet" ) = "white"
gvaCSSColors.Item( "Brown" ) = "white"
gvaCSSColors.Item( "BurlyWood" ) = "black"
gvaCSSColors.Item( "CadetBlue" ) = "black"
gvaCSSColors.Item( "Chartreuse" ) = "black"
gvaCSSColors.Item( "Chocolate" ) = "white"
gvaCSSColors.Item( "Coral" ) = "black"
gvaCSSColors.Item( "CornflowerBlue" ) = "black"
gvaCSSColors.Item( "Cornsilk" ) = "black"
gvaCSSColors.Item( "Crimson" ) = "white"
gvaCSSColors.Item( "Cyan" ) = "black"
gvaCSSColors.Item( "DarkBlue" ) = "white"
gvaCSSColors.Item( "DarkCyan" ) = "white"
gvaCSSColors.Item( "DarkGoldenRod" ) = "black"
gvaCSSColors.Item( "DarkGray" ) = "black"
gvaCSSColors.Item( "DarkGrey" ) = "black"
gvaCSSColors.Item( "DarkGreen" ) = "white"
gvaCSSColors.Item( "DarkKhaki" ) = "black"
gvaCSSColors.Item( "DarkMagenta" ) = "white"
gvaCSSColors.Item( "DarkOliveGreen" ) = "white"
gvaCSSColors.Item( "DarkOrange" ) = "black"
gvaCSSColors.Item( "DarkOrchid" ) = "white"
gvaCSSColors.Item( "DarkRed" ) = "white"
gvaCSSColors.Item( "DarkSalmon" ) = "black"
gvaCSSColors.Item( "DarkSeaGreen" ) = "black"
gvaCSSColors.Item( "DarkSlateBlue" ) = "white"
gvaCSSColors.Item( "DarkSlateGray" ) = "white"
gvaCSSColors.Item( "DarkSlateGrey" ) = "white"
gvaCSSColors.Item( "DarkTurquoise" ) = "black"
gvaCSSColors.Item( "DarkViolet" ) = "white"
gvaCSSColors.Item( "DeepPink" ) = "white"
gvaCSSColors.Item( "DeepSkyBlue" ) = "black"
gvaCSSColors.Item( "DimGray" ) = "white"
gvaCSSColors.Item( "DimGrey" ) = "white"
gvaCSSColors.Item( "DodgerBlue" ) = "white"
gvaCSSColors.Item( "FireBrick" ) = "white"
gvaCSSColors.Item( "FloralWhite" ) = "black"
gvaCSSColors.Item( "ForestGreen" ) = "white"
gvaCSSColors.Item( "Fuchsia" ) = "white"
gvaCSSColors.Item( "Gainsboro" ) = "black"
gvaCSSColors.Item( "GhostWhite" ) = "black"
gvaCSSColors.Item( "Gold" ) = "black"
gvaCSSColors.Item( "GoldenRod" ) = "black"
gvaCSSColors.Item( "Gray" ) = "black"
gvaCSSColors.Item( "Grey" ) = "black"
gvaCSSColors.Item( "Green" ) = "white"
gvaCSSColors.Item( "GreenYellow" ) = "black"
gvaCSSColors.Item( "HoneyDew" ) = "black"
gvaCSSColors.Item( "HotPink" ) = "black"
gvaCSSColors.Item( "IndianRed" ) = "white"
gvaCSSColors.Item( "Indigo" ) = "white"
gvaCSSColors.Item( "Ivory" ) = "black"
gvaCSSColors.Item( "Khaki" ) = "black"
gvaCSSColors.Item( "Lavender" ) = "black"
gvaCSSColors.Item( "LavenderBlush" ) = "black"
gvaCSSColors.Item( "LawnGreen" ) = "black"
gvaCSSColors.Item( "LemonChiffon" ) = "black"
gvaCSSColors.Item( "LightBlue" ) = "black"
gvaCSSColors.Item( "LightCoral" ) = "black"
gvaCSSColors.Item( "LightCyan" ) = "black"
gvaCSSColors.Item( "LightGoldenRodYellow" ) = "black"
gvaCSSColors.Item( "LightGray" ) = "black"
gvaCSSColors.Item( "LightGrey" ) = "black"
gvaCSSColors.Item( "LightGreen" ) = "black"
gvaCSSColors.Item( "LightPink" ) = "black"
gvaCSSColors.Item( "LightSalmon" ) = "black"
gvaCSSColors.Item( "LightSeaGreen" ) = "black"
gvaCSSColors.Item( "LightSkyBlue" ) = "black"
gvaCSSColors.Item( "LightSlateGray" ) = "black"
gvaCSSColors.Item( "LightSlateGrey" ) = "black"
gvaCSSColors.Item( "LightSteelBlue" ) = "black"
gvaCSSColors.Item( "LightYellow" ) = "black"
gvaCSSColors.Item( "Lime" ) = "black"
gvaCSSColors.Item( "LimeGreen" ) = "black"
gvaCSSColors.Item( "Linen" ) = "black"
gvaCSSColors.Item( "Magenta" ) = "white"
gvaCSSColors.Item( "Maroon" ) = "white"
gvaCSSColors.Item( "MediumAquaMarine" ) = "black"
gvaCSSColors.Item( "MediumBlue" ) = "white"
gvaCSSColors.Item( "MediumOrchid" ) = "black"
gvaCSSColors.Item( "MediumPurple" ) = "black"
gvaCSSColors.Item( "MediumSeaGreen" ) = "black"
gvaCSSColors.Item( "MediumSlateBlue" ) = "white"
gvaCSSColors.Item( "MediumSpringGreen" ) = "black"
gvaCSSColors.Item( "MediumTurquoise" ) = "black"
gvaCSSColors.Item( "MediumVioletRed" ) = "white"
gvaCSSColors.Item( "MidnightBlue" ) = "white"
gvaCSSColors.Item( "MintCream" ) = "black"
gvaCSSColors.Item( "MistyRose" ) = "black"
gvaCSSColors.Item( "Moccasin" ) = "black"
gvaCSSColors.Item( "NavajoWhite" ) = "black"
gvaCSSColors.Item( "Navy" ) = "white"
gvaCSSColors.Item( "OldLace" ) = "black"
gvaCSSColors.Item( "Olive" ) = "white"
gvaCSSColors.Item( "OliveDrab" ) = "white"
gvaCSSColors.Item( "Orange" ) = "black"
gvaCSSColors.Item( "OrangeRed" ) = "white"
gvaCSSColors.Item( "Orchid" ) = "black"
gvaCSSColors.Item( "PaleGoldenRod" ) = "black"
gvaCSSColors.Item( "PaleGreen" ) = "black"
gvaCSSColors.Item( "PaleTurquoise" ) = "black"
gvaCSSColors.Item( "PaleVioletRed" ) = "black"
gvaCSSColors.Item( "PapayaWhip" ) = "black"
gvaCSSColors.Item( "PeachPuff" ) = "black"
gvaCSSColors.Item( "Peru" ) = "black"
gvaCSSColors.Item( "Pink" ) = "black"
gvaCSSColors.Item( "Plum" ) = "black"
gvaCSSColors.Item( "PowderBlue" ) = "black"
gvaCSSColors.Item( "Purple" ) = "white"
gvaCSSColors.Item( "RebeccaPurple" ) = "white"
gvaCSSColors.Item( "Red" ) = "white"
gvaCSSColors.Item( "RosyBrown" ) = "black"
gvaCSSColors.Item( "RoyalBlue" ) = "white"
gvaCSSColors.Item( "SaddleBrown" ) = "white"
gvaCSSColors.Item( "Salmon" ) = "black"
gvaCSSColors.Item( "SandyBrown" ) = "black"
gvaCSSColors.Item( "SeaGreen" ) = "white"
gvaCSSColors.Item( "SeaShell" ) = "black"
gvaCSSColors.Item( "Sienna" ) = "white"
gvaCSSColors.Item( "Silver" ) = "black"
gvaCSSColors.Item( "SkyBlue" ) = "black"
gvaCSSColors.Item( "SlateBlue" ) = "white"
gvaCSSColors.Item( "SlateGray" ) = "white"
gvaCSSColors.Item( "SlateGrey" ) = "white"
gvaCSSColors.Item( "Snow" ) = "black"
gvaCSSColors.Item( "SpringGreen" ) = "black"
gvaCSSColors.Item( "SteelBlue" ) = "white"
gvaCSSColors.Item( "Tan" ) = "black"
gvaCSSColors.Item( "Teal" ) = "white"
gvaCSSColors.Item( "Thistle" ) = "black"
gvaCSSColors.Item( "Tomato" ) = "black"
gvaCSSColors.Item( "Turquoise" ) = "black"
gvaCSSColors.Item( "Violet" ) = "black"
gvaCSSColors.Item( "Wheat" ) = "black"
gvaCSSColors.Item( "White" ) = "black"
gvaCSSColors.Item( "WhiteSmoke" ) = "black"
gvaCSSColors.Item( "Yellow" ) = "black"
gvaCSSColors.Item( "YellowGreen" ) = "black"
End Sub
Function Max( num1, num2 )
If CInt( num1 ) > CInt( num2 ) Then
Max = CInt( num1 )
Else
Max = CInt( num2 )
End If
End Function
Function Min( num1, num2 )
If CInt( num1 ) < CInt( num2 ) Then
Min = CInt( num1 )
Else
Min = CInt( num2 )
End If
End Function
Sub OnClick_CheckboxDMIDecode( )
If gvbWinPE Then
CheckboxDMIDecode.checked = False
CheckboxDMIDecode.disabled = True
End If
End Sub
Sub OnClick_CheckboxDxDiag( )
If gvbWinPE Then
CheckboxDxDiag.checked = False
CheckboxDxDiag.disabled = True
CheckboxKeepXML.checked = False
CheckboxKeepXML.disabled = True
End If
CheckboxKeepXML.checked = CheckboxKeepXML.checked And CheckboxDxDiag.checked
If CheckboxDxDiag.checked Then
TablerowKeepXML.style.display = "table-row"
TablerowKeepXML.style.visibility = "visible"
TablerowDxDiagPath.style.display = "table-row"
TablerowDxDiagPath.style.visibility = "visible"
Else
gvaSettingsStr.Item( "XML" ) = gvaDefaultsStr.Item( "XML" )
TablerowKeepXML.style.display = "none"
TablerowKeepXML.style.visibility = "collapse"
TablerowDxDiagPath.style.display = "none"
TablerowDxDiagPath.style.visibility = "collapse"
End If
InputDxDiag.value = gvaSettingsStr.Item( "XML" )
End Sub
Sub PasteFromClipboard
Dim strText
On Error Resume Next ' REQUIRED
strText = Document.ParentWindow.ClipboardData.GetData( "text" )
If Err Then
MsgBox "An error occurred while trying to paste data from the clipboard:" & vbCrLf & vbCrLf & Err.Description, vbOKOnly, "Clipboard Error"
Else
If Not IsNull( strText ) Then ComputerName.value = strText
End If
On Error Goto 0
End Sub
Sub Print( )
' Build an HTML table with the results, to allow printing
Dim arrData, arrHeader, i, j, objPrintFile, strHTML, strTable
' Create a temporary HTML file and open it in the default browser
strHTML = "<html>" _
& "<head>" _
& "<title>Basic Hardware Inventory " & Hardware.Version & " - © 2005 - " & COPYRIGHTS_YEAR & " Rob van der Woude</title>" & vbCrLf _
& "<style type=""text/css"">" & vbCrLf _
& ".Odd { background-color: silver; }" & vbCrLf _
& "</style>" & vbCrLf _
& "</head>" & vbCrLf _
& "<body>" & vbCrLf _
& PrintTable( ) _
& "</body>" & vbCrLf _
& "</html>" & vbCrLf
Set objPrintFile = gvoFSO.CreateTextFile( gvsPrintFile )
objPrintFile.Write( strHTML )
objPrintFile.Close
Set objPrintFile = Nothing
gvoWSHShell.Run gvsPrintFile, 7, False
End Sub
Function PrintTable( )
Dim arrData, arrHeader, i, strClass, strTable
strTable = "<table style=""border: 1px solid black; width: 100%;"">" & vbCrLf
strTable = strTable _
& "<thead style=""font-weight: bold; font-size: 120%; display: table-header-group; page-break-before: always;"">" & vbCrLf _
& "<tr class=""Odd"" style=""page-break-inside: avoid;"">" & vbCrLf _
& " <th style=""page-break-inside: avoid; border: 1px solid black;"">Component</th>" & vbCrLf _
& " <th style=""page-break-inside: avoid; border: 1px solid black;"">Value</th>" & vbCrLf _
& "</tr>" & vbCrLf _
& "</thead>" & vbCrLf _
& "<tbody>" & vbCrLf
arrData = Split( gvsCSVTxt, vbTab, -1, 1 )
arrHeader = Split( gvsHeader, vbTab, -1, 1 )
For i = 0 To Min( UBound( arrHeader ), UBound( arrData ) )
If i Mod 2 = 0 Then
strClass = ""
Else
strClass = " class=""Odd"""
End If
strTable = strTable _
& "<tr" & strClass & " style=""page-break-inside: avoid;"">" & vbCrLf _
& " <th style=""page-break-inside: avoid; border: 1px solid black; text-align: left; padding: 5px;"">" & arrHeader(i) & "</th>" & vbCrLf _
& " <td style=""page-break-inside: avoid; border: 1px solid black; text-align: left; padding: 5px;"">" & arrData(i) & "</td>" & vbCrLf _
& "</tr>" & vbCrLf
Next
strTable = strTable _
& "</tbody>" & vbCrLf _
& "</table>" & vbCrLf
PrintTable = strTable
End Function
Sub Reset( )
window_onunload
Location.Reload True
End Sub
Sub SaveSettings( )
ConfigSaveChanges
ConfigSaveFile
ConfigUpdateStatus
ShowMain
End Sub
Function SaveTabDelimited( )
Dim objFile, strFile, strMsg, strWinPE
SaveTabDelimited = ""
If gvbWinPE Then
strWinPE = ".WinPE."
Else
strWinPE = "."
End If
If gvaSettingsStr.Item( "SAVE" ) = "*" Or gvaSettingsStr.Item( "SAVE" ) = "" Then
strFile = gvoFSO.BuildPath( gvoFSO.GetParentFolderName( Self.location.pathname ), "Hardware." & gvaDefaultsStr.Item( "COMPUTER" ) & strWinPE & Replace( Replace( TimeStamp( ), ":", "" ), " ", "_" ) & ".txt" )
ElseIf Right( gvaSettingsStr.Item( "SAVE" ), 2 ) = "\*" Then
strFile = Left( gvaSettingsStr.Item( "SAVE" ), Len( gvaSettingsStr.Item( "SAVE" ) ) - 1 ) & "Hardware." & gvaDefaultsStr.Item( "COMPUTER" ) & strWinPE & TimeStamp( ) & ".txt"
Else
strFile = gvaSettingsStr.Item( "SAVE" )
End If
If InStr( gvaSettingsStr.Item( "SAVE" ), "\" ) = -1 Then
strFile = gvoFSO.BuildPath( gvoFSO.GetParentFolderName( Self.location.pathname ), strFile )
End If
If strFile <> "" Then
If Left( strFile, 1 ) = """" Then strFile = Mid( strFile, 2 )
If Right( strFile, 1 ) = """" Then strFile = Left( strFile, Len( strFile ) - 1 )
End If
With gvoFSO
If .FolderExists( .GetParentFolderName( strFile ) ) Then
On Error Resume Next ' REQUIRED
strFile = .GetAbsolutePathName( strFile )
Set objFile = .CreateTextFile( strFile, True, False )
If Err Then
strMsg = "Error #" & Err.Number & " while trying to save the results to """ & strFile & """:"
strMsg = strMsg & vbCrLf & Err.Description
MsgBox strMsg, vbOKOnly, "File Save Error"
strFile = ""
Else
objFile.WriteLine gvsHeader
objFile.WriteLine gvsCSVTxt
objFile.Close
If Not gvbSilent Then MsgBox "File """ & strFile & """ successfully saved.", vbOKOnly, "File Saved"
End If
Set objFile = Nothing
On Error Goto 0
Else
MsgBox "Folder """ & .GetParentFolderName( strFile ) & """ does not exist.", vbOKOnly, "File save error"
strFile = ""
End If
End With
SaveTabDelimited = strFile
End Function
Sub SetCustomColor( myDropdown )
Dim arrCustomColors, colElements, objDropdown, objElement, objOption
arrCustomColors = Split( gvaSettingsStr.Item( "CUSTOMCOLORS" ), ";" )
Set objDropdown = document.getElementById( myDropdown )
For Each objOption In objDropdown.options
If objOption.selected Then
Select Case myDropdown
Case "BackgroundColor":
document.body.style.backgroundColor = arrCustomColors(0)
Case "CaptionsColor":
document.body.style.color = arrCustomColors(1)
Case "LinksColor":
Set colElements = document.getElementsByTagName( "a" )
For Each objElement In colElements
objElement.style.color = arrCustomColors(2)
Next
Set colElements = Nothing
Case "ButtonFaceColor":
Set colElements = document.getElementsByTagName( "input" )
For Each objElement In colElements
If objElement.type = "button" Then
objElement.style.backgroundColor = arrCustomColors(3)
End If
Next
Set colElements = Nothing
Case "ButtonCaptionsColor":
Set colElements = document.getElementsByTagName( "input" )
For Each objElement In colElements
If objElement.type = "button" Then
objElement.style.color = arrCustomColors(4)
End If
Next
Set colElements = Nothing
Case "CodeColor":
Set colElements = document.getElementsByTagName( "code" )
For Each objElement In colElements
objElement.style.color = arrCustomColors(5)
Next
Set colElements = Nothing
End Select
End If
Next
Set objDropdown = Nothing
End Sub
Sub SetCustomTheme( )
Dim objOption, strCustomColors
ThemeBlue.checked = False
ThemeBW.checked = False
ThemeRed.checked = False
ThemeCustom.checked = True
gvaSettingsStr.Item( "THEME" ) = "ThemeCustom"
For Each objOption In BackgroundColor.options
If objOption.selected Then strCustomColors = objOption.value
Next
For Each objOption In CaptionsColor.options
If objOption.selected Then strCustomColors = strCustomColors & ";" & objOption.value
Next
For Each objOption In LinksColor.options
If objOption.selected Then strCustomColors = strCustomColors & ";" & objOption.value
Next
For Each objOption In ButtonFaceColor.options
If objOption.selected Then strCustomColors = strCustomColors & ";" & objOption.value
Next
For Each objOption In ButtonCaptionsColor.options
If objOption.selected Then strCustomColors = strCustomColors & ";" & objOption.value
Next
For Each objOption In CodeColor.options
If objOption.selected Then strCustomColors = strCustomColors & ";" & objOption.value
Next
gvaSettingsStr.Item( "CUSTOMCOLORS" ) = LCase( strCustomColors )
End Sub
Sub SetTheme( )
If ThemeBW.checked Then
If gvaSettingsStr.Item( "THEME" ) = "ThemeBlue" Then
Exit Sub
Else
gvaSettingsStr.Item( "THEME" ) = "ThemeBlue"
End If
ElseIf ThemeBW.checked Then
If gvaSettingsStr.Item( "THEME" ) = "ThemeBW" Then
Exit Sub
Else
gvaSettingsStr.Item( "THEME" ) = "ThemeBW"
End If
ElseIf ThemeCustom.checked Then
gvaSettingsStr.Item( "THEME" ) = "ThemeCustom"
ElseIf ThemeDark.checked Then
If gvaSettingsStr.Item( "THEME" ) = "ThemeDark" Then
Exit Sub
Else
gvaSettingsStr.Item( "THEME" ) = "ThemeDark"
End If
ElseIf ThemeRed.checked Then
If gvaSettingsStr.Item( "THEME" ) = "ThemeRed" Then
Exit Sub
Else
gvaSettingsStr.Item( "THEME" ) = "ThemeRed"
End If
ElseIf Not gvaSettingsStr.Item( "THEME" ) = "ThemeBW" Then
gvaSettingsStr.Item( "THEME" ) = "ThemeBW"
End If
End Sub
Sub ShowCredits( )
MainScreen.style.display = "none"
SettingsScreen.style.display = "none"
HelpScreen.style.display = "none"
CreditsScreen.style.display = "block"
Back.style.display = "block"
End Sub
Sub ShowDonate( )
gvoWSHShell.Run "https://www.robvanderwoude.com/donate.php", 7, False
End Sub
Sub ShowHelp( )
MainScreen.style.display = "none"
SettingsScreen.style.display = "none"
HelpScreen.style.display = "block"
CreditsScreen.style.display = "none"
Back.style.display = "block"
End Sub
Sub ShowMain( )
MainScreen.style.display = "block"
SettingsScreen.style.display = "none"
HelpScreen.style.display = "none"
CreditsScreen.style.display = "none"
Back.style.display = "none"
End Sub
Sub ShowSettings( )
MainScreen.style.display = "none"
SettingsScreen.style.display = "block"
HelpScreen.style.display = "none"
CreditsScreen.style.display = "none"
Back.style.display = "none"
ButtonEditCfg.disabled = Not gvoFSO.FileExists( gvsConfigFile )
If gvaSettingsBool.Item( "DEVTEST" ) Then
InputDxDiag.value = "C:\Scripts\Hardware.xml"
End If
If InputDxDiag.value = "" Then
ButtonDeleteXML.disabled = True
Else
If gvoFSO.FileExists( InputDxDiag.value ) Then
ButtonDeleteXML.disabled = False
Else
ButtonDeleteXML.disabled = True
End If
End If
ButtonReset.disabled = ConfigTestIfDefault( )
End Sub
Sub Sleep( seconds )
Dim objShell, strCmd
Set objShell = CreateObject( "Wscript.Shell" )
strCmd = "%COMSPEC% /C PING -n " & seconds & " localhost > NUL 2>&1"
objShell.Run strCmd, 0, 1
Set objShell = Nothing
End Sub
Function TextFromHTML( myURL )
Dim objHTTP
TextFromHTML = ""
On Error Resume Next ' REQUIRED
Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
objHTTP.Open "GET", myURL
objHTTP.Send
If Err Then gvbConnected = False
' Check if the result was valid, and if so return the result
If objHTTP.Status = 200 Then TextFromHTML = objHTTP.ResponseText
Set objHTTP = Nothing
On Error Goto 0
End Function
Function TimeStamp( )
TimeStamp = Year( Now ) _
& "-" _
& Right( "0" & Month( Now ), 2 ) _
& "-" _
& Right( "0" & Day( Now ), 2 ) _
& " " _
& Right( "0" & Hour( Now ), 2 ) _
& ":" _
& Right( "0" & Minute( Now ), 2 ) _
& ":" _
& Right( "0" & Second( Now ), 2 )
End Function
Sub ValidateZoomFactor( )
Dim intZoomFactor, objRE
intZoomFactor = Trim( InputZoomFactor.value )
Set objRE = New RegExp
objRE.Pattern = "[^\d]"
objRE.Global = True
If Not objRE.Replace( intZoomFactor, "" ) = intZoomFactor Then
intZoomFactor = objRE.Replace( intZoomFactor, "" )
End If
Set objRE = Nothing
If intZoomFactor > 250 Then
intZoomFactor = 250
End If
If Not intZoomFactor = InputZoomFactor.value Then
InputZoomFactor.value = intZoomFactor
End If
End Sub
Sub window_onunload
On Error Resume Next ' REQUIRED
' Delete DxDiag's XML file if it exists, unless /KEEPXML switch was used
If gvaSettingsBool.Item( "DXDIAG" ) Then
If Not gvaSettingsBool.Item( "KEEPXML" ) Then
If Trim( gvaSettingsStr.Item( "XML" ) ) <> "" Then
If gvoFSO.FileExists( gvaSettingsStr.Item( "XML" ) ) Then
gvoFSO.DeleteFile gvaSettingsStr.Item( "XML" ), True
End If
End If
End If
End If
' Delete temporary files
With gvoFSO
If .FileExists( gvsDetailsFile ) Then .DeleteFile gvsDetailsFile, True
If .FileExists( gvsPrintFile ) Then .DeleteFile gvsPrintFile, True
End With
' "Gracefully" close objects
Set gvaCSSColors = Nothing
Set gvaDefaultsBool = Nothing
Set gvaSettingsBool = Nothing
Set gvaSettingsStr = Nothing
Set gvoFSO = Nothing
Set gvoWMIlocalCimv2 = Nothing
Set gvoWMIrootCimv2 = Nothing
Set gvoWMIrootMSWinStorage = Nothing
Set gvoWMIrootStandardCimv2 = Nothing
Set gvoWMIrootWMI = Nothing
Set gvoWSHShell = Nothing
Set gvoHDDInterfaces = Nothing
Set gvoRandom = Nothing
On Error Goto 0
End Sub
</script>
<body onhelp="vbscript:ShowHelp" onkeydown="vbscript:CheckKey">
<div align="center">
<div id="MainScreen" class="DontPrint">
<table>
<tr>
<td><input id="ButtonPaste" class="Button" type="button" value="Paste" onclick="vbscript:PasteFromClipboard" title="Click here to paste a remote computer name from the clipboard into the Computer Name field. Then click the [Go] button to start the inventory." /></td>
<td> </td>
<td><strong>Computer:</strong></td>
<td> </td>
<td><input id="ComputerName" size="20" type="text" oncontextmenu="javascript:this.select();" title="Paste or type a remote computer name, or leave this field blank to query the local computer. Then click the [Go] button to start the inventory." onkeypress="vbscript:CheckKey" /></td>
<td> </td>
<td><input id="ButtonBasic" class="Button" type="button" value="Basic" onclick="vbscript:Basic" title="Click this button to toggle between Basic and Full Inventory." accesskey="b" /></td>
<td> </td>
<td><input id="ButtonRun" class="Button" type="button" value="Go" onclick="vbscript:Inventory" title="Click here to start the inventory" accesskey="g" /></td>
</tr>
</table>
<table id="Results" class="Center">
<thead>
<tr>
<td colspan="17"> </td>
</tr>
</thead>
<tbody>
<tr id="CPUHeader">
<td colspan="4"> </td>
<td>Number:</td>
<td> </td>
<td colspan="3">Model:</td>
<td> </td>
<td>Speed (MHz):</td>
<td> </td>
<td>Socket:</td>
<td> </td>
<td class="Scores" title="This read-only field will display the Windows System Assessment Tool (WinSAT) CPU score.">Score:</td>
<td class="Scores"> </td>
<td> </td>
</tr>
<tr id="CPURow">
<td><input type="checkbox" id="CheckboxCPU" checked title="Deselect this checkbox if you want to exclude the processor(s) from the inventory." /></td>
<td><label for="CheckboxCPU"> </label></td>
<th class="Left"><label for="CheckboxCPU">CPU<span id="MultipleCPUs" style="display: none;">s</span>:</label></th>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="CPUNumber" size="12" readonly title="This read-only field will display the number of (logical) processors found. For processors with hyperthreading the displayed number will be twice the number of physical processors." /></td>
<td> </td>
<td colspan="3"><input type="text" oncontextmenu="javascript:this.select();" id="CPUModel" size="40" readonly title="This read-only field will display the processor type." /></td>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="CPUSpeed" size="16" readonly title="This read-only field will display the processor clock speed in MHz." /></td>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="CPUSocket" size="16" readonly title="This read-only field will display the processor socket type." /></td>
<td> </td>
<td class="Scores"><input type="text" oncontextmenu="javascript:this.select();" id="CPUScore" size="3" readonly title="This read-only field will display the Windows System Assessment Tool (WinSAT) CPU score." style="text-align: right;" /></td>
<td class="Scores"> </td>
<td><input id="ButtonDetailsCPU" class="Button" type="button" value=" Details " onclick="vbscript:DetailsCPU" title="Click here to display more processor details in a separate window." /></td>
</tr>
<tr id="CPUFooter">
<td colspan="14"> </td>
<td class="Scores"> </td>
<td class="Scores"> </td>
<td> </td>
</tr>
<tr id="MemHeader">
<td colspan="4"> </td>
<td>Banks:</td>
<td> </td>
<td>Modules:</td>
<td> </td>
<td>Total (MB):</td>
<td> </td>
<td>Speed (ns):</td>
<td> </td>
<td>Form Factor:</td>
<td> </td>
<td class="Scores" title="This read-only field will display the Windows System Assessment Tool (WinSAT) Memory Score.">Score:</td>
<td class="Scores"> </td>
<td> </td>
</tr>
<tr id="MemRow">
<td><input type="checkbox" id="CheckboxMemory" checked title="Deselect this checkbox if you want to exclude the memory from the inventory." /></td>
<td><label for="CheckboxMemory"> </label></td>
<th class="Left"><label for="CheckboxMemory">Memory:</label></th>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="MemoryBanks" size="12" readonly title="This read-only field will display the number of memory banks (sockets total)." /></td>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="MemoryModules" size="16" readonly title="This read-only field will display the number of memory modules (sockets used)." /></td>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="MemorySize" size="16" readonly title="This read-only field will display the total amount of physical memory in MB." /></td>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="MemorySpeed" size="16" readonly title="This read-only field will display the memory speed in ns." /></td>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="MemoryFormFactor" size="16" readonly title="This read-only field will display the memory modules' form factor." /></td>
<td> </td>
<td class="Scores"><input type="text" oncontextmenu="javascript:this.select();" id="MemoryScore" size="3" readonly title="This read-only field will display the Windows System Assessment Tool (WinSAT) Memory Score." style="text-align: right;" /></td>
<td class="Scores"> </td>
<td><input id="ButtonDetailsMemory" class="Button" type="button" value=" Details " onclick="vbscript:DetailsMemory" title="Click here to display more memory details in a separate window." /></td>
</tr>
<tr id="MemFooter">
<td colspan="14"> </td>
<td class="Scores" colspan="2"> </td>
<td> </td>
</tr>
<tr id="HardDiskHeader">
<td colspan="4"> </td>
<td>Disk #:</td>
<td> </td>
<td colspan="3">Model:</td>
<td> </td>
<td>Size (GB):</td>
<td> </td>
<td>Interface:</td>
<td> </td>
<td class="Scores" title="This read-only field will display the Windows System Assessment Tool (WinSAT) Disk Score.">Score:</td>
<td class="Scores"> </td>
<td> </td>
</tr>
<tr id="HardDisk0">
<td><input type="checkbox" id="CheckboxHDD" checked title="Deselect this checkbox if you want to exclude the harddisk(s) from the inventory." /></td>
<td><label for="CheckboxHDD"> </label></td>
<th class="Left"><label for="CheckboxHDD">Harddisk<span id="MultipleHDUs" style="display: none;">s</span>:</label></th>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="HardDisk0Index" size="12" readonly title="This read-only field will display the disk number (zero based: 0...3)." /></td>
<td> </td>
<td colspan="3"><input type="text" oncontextmenu="javascript:this.select();" id="HardDisk0Model" size="40" readonly title="This read-only field will display the harddisk model." /></td>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="HardDisk0Size" size="16" readonly title="This read-only field will display the harddisk size (capacity) in GB." /></td>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="HardDisk0Interface" size="16" readonly title="This read-only field will display the harddisk's interface type (IDE/SCSI/S-ATA)." /></td>
<td> </td>
<td class="Scores"><input type="text" oncontextmenu="javascript:this.select();" id="DiskScore" size="3" readonly title="This read-only field will display the Windows System Assessment Tool (WinSAT) Disk Score." style="text-align: right;" /></td>
<td class="Scores"> </td>
<td><input id="ButtonDetailsHDD" class="Button" type="button" value=" Details " onclick="vbscript:DetailsHDD" title="Click here to display more harddisk details in a separate window." /></td>
</tr>
<tr id="HardDiskFooter">
<td colspan="14"> </td>
<td class="Scores" colspan="2"> </td>
<td> </td>
</tr>
<tr id="CDROMHeader">
<td colspan="4"> </td>
<td>Drive:</td>
<td> </td>
<td colspan="3">Model:</td>
<td> </td>
<td>Firmware:</td>
<td> </td>
<td>Interface:</td>
<td> </td>
<td class="Scores" colspan="2"> </td>
<td> </td>
</tr>
<tr id="CDROM0">
<td><input type="checkbox" id="CheckboxCDROM" checked title="Deselect this checkbox if you want to exclude the CD/DVD-ROM drive(s) from the inventory." /></td>
<td><label for="CheckboxCDROM"> </label></td>
<th class="Left"><label for="CheckboxCDROM">CDROM<span id="MultipleCDROMs" style="display: none;">s</span>:</label></th>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="CDROM0Index" size="12" readonly title="This read-only field will display the CD/DVD-ROM drive letter." /></td>
<td> </td>
<td colspan="3"><input type="text" oncontextmenu="javascript:this.select();" id="CDROM0Model" size="40" readonly title="This read-only field will display the CD/DVD-ROM drive model." /></td>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="CDROM0Firmware" size="16" readonly title="This read-only field will display the CD/DVD-ROM drive's firmware revision number." /></td>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="CDROM0Interface" size="16" readonly title="This read-only field will display the CD/DVD-ROM drive's interface type (IDE/SCSI/S-ATA)." /></td>
<td> </td>
<td class="Scores" colspan="2"> </td>
<td><input id="ButtonDetailsCDROM" class="Button" type="button" value=" Details " onclick="vbscript:DetailsCDROM" title="Click here to display more CD/DVD-ROM details in a separate window." /></td>
</tr>
<tr id="CDROMFooter">
<td colspan="14"> </td>
<td class="Scores" colspan="2"> </td>
<td> </td>
</tr>
<tr id="FDDHeader">
<td colspan="4"> </td>
<td>Drive:</td>
<td> </td>
<td colspan="3">Description:</td>
<td> </td>
<td>Capacity:</td>
<td> </td>
<td>Interface:</td>
<td> </td>
<td class="Scores" colspan="2"> </td>
<td> </td>
</tr>
<tr id="FDD0">
<td><input type="checkbox" id="CheckboxFDD" checked title="Deselect this checkbox if you want to exclude floppy drives from the inventory." /></td>
<td><label for="CheckboxFDD"> </label></td>
<th class="Left"><label for="CheckboxFDD">Floppy disk<span id="MultipleFDDs" style="display: none;">s</span>:</label></th>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="FDD0DeviceID" size="12" readonly title="This read-only field will display the floppy drive letter." /></td>
<td> </td>
<td colspan="3"><input type="text" oncontextmenu="javascript:this.select();" id="FDD0Description" size="40" readonly title="This read-only field will display the floppy drive description." /></td>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="FDD0Capacity" size="16" readonly title="This read-only field will display the floppy drive capacity." /></td>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="FDD0Interface" size="16" readonly title="This read-only field will display the floppy drive's interface type (USB/Flatcable)." /></td>
<td> </td>
<td class="Scores" colspan="2"> </td>
<td><input id="ButtonDetailsFDD" class="Button" type="button" value=" Details " onclick="vbscript:DetailsFDD" title="Click here to display more floppy drive details in a separate window." /></td>
</tr>
<tr id="FDDFooter">
<td colspan="14"> </td>
<td class="Scores" colspan="2"> </td>
<td> </td>
</tr>
<tr id="VideoHeader">
<td colspan="4"> </td>
<td>Video #:</td>
<td> </td>
<td colspan="3">Model:</td>
<td> </td>
<td>Memory (MB):</td>
<td> </td>
<td>Resolution:</td>
<td> </td>
<td class="Scores" title="This read-only field will display the Windows System Assessment Tool (WinSAT) Graphics Score.">Score:</td>
<td class="Scores"> </td>
<td> </td>
</tr>
<tr id="Video0">
<td><input type="checkbox" id="CheckboxVideo" checked title="Deselect this checkbox if you want to exclude the display adapter(s) from the inventory." /></td>
<td><label for="CheckboxVideo"> </label></td>
<th class="Left"><label for="CheckboxVideo">Video:</label></th>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="VideoIndex0" size="12" readonly title="This read-only field will display the (logical) display adapter number (zero based)." /></td>
<td> </td>
<td colspan="3"><input type="text" oncontextmenu="javascript:this.select();" id="VideoModel0" size="40" readonly title="This read-only field will display the display adapter model." /></td>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="VideoMemory0" size="16" readonly title="This read-only field will display the amount of video memory in MB." /></td>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="VideoMode0" size="16" readonly title="This read-only field will display the current video mode." /></td>
<td> </td>
<td class="Scores"><input type="text" oncontextmenu="javascript:this.select();" id="GraphicsScore" size="3" readonly title="This read-only field will display the Windows System Assessment Tool (WinSAT) Graphics Score." style="text-align: right;" /></td>
<td class="Scores"> </td>
<td><input id="ButtonDetailsVideo" class="Button" type="button" value=" Details " onclick="vbscript:DetailsVideo" title="Click here to display more display adapter details in a separate window." /></td>
</tr>
<tr id="VideoFooter">
<td colspan="14"> </td>
<td class="Scores" colspan="2"> </td>
<td> </td>
</tr>
<tr id="MonitorHeader">
<td colspan="4"> </td>
<td>Monitor #:</td>
<td> </td>
<td id="MonitorModelCaption" colspan="3">Model:</td>
<td> </td>
<td>Manufacturer:</td>
<td> </td>
<td>Serial #:</td>
<td> </td>
<td class="Scores" colspan="2"> </td>
<td> </td>
</tr>
<tr id="Monitor0">
<td><input type="checkbox" id="CheckboxMonitor" checked title="Deselect this checkbox if you want to exclude the monitor(s) from the inventory." /></td>
<td><label for="CheckboxMonitor"> </label></td>
<th class="Left"><label for="CheckboxMonitor">Monitor<span id="MultipleMonitors" style="display: none;">s</span>:</labe></th>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="MonitorIndex0" size="12" readonly title="This read-only field will display the monitor number (zero based)." /></td>
<td> </td>
<td colspan="3"><input type="text" oncontextmenu="javascript:this.select();" id="MonitorModel0" size="40" readonly title="This read-only field will display the monitor model." /></td>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="MonitorManufacturer0" size="16" readonly title="This read-only field will display the monitor manufacturer." /></td>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="MonitorSerial0" size="16" readonly title="This read-only field will display the monitor serial number." /></td>
<td> </td>
<td class="Scores" colspan="2"> </td>
<td><input id="ButtonDetailsMonitor" class="Button" type="button" value=" Details " onclick="vbscript:DetailsMonitor" title="Click here to display more monitor details in a separate window." /></td>
</tr>
<tr id="MonitorFooter">
<td colspan="14"> </td>
<td class="Scores" colspan="2"> </td>
<td> </td>
</tr>
<tr id="SoundHeader">
<td colspan="6"> </td>
<td colspan="3">Model:</td>
<td> </td>
<td>Manufacturer:</td>
<td colspan="3"> </td>
<td class="Scores" colspan="2"> </td>
<td> </td>
</tr>
<tr id="SoundRow">
<td><input type="checkbox" id="CheckboxSound" checked title="Deselect this checkbox if you want to exclude the sound card from the inventory." /></td>
<td><label for="CheckboxSound"> </label></td>
<th class="Left"><label for="CheckboxSound">Sound:</label></th>
<td colspan="3"> </td>
<td colspan="3"><input type="text" oncontextmenu="javascript:this.select();" id="SoundCardModel" size="40" readonly title="This read-only field will display the sound card model." /></td>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="SoundCardManufacturer" size="16" readonly title="This read-only field will display the name of the sound card manufacturer." /></td>
<td colspan="3"> </td>
<td class="Scores" colspan="2"> </td>
<td><input id="ButtonDetailsSound" class="Button" type="button" value=" Details " onclick="vbscript:DetailsSound" title="Click here to display more sound card details in a separate window." /></td>
</tr>
<tr id="SoundFooter">
<td colspan="14"> </td>
<td class="Scores" colspan="2"> </td>
<td> </td>
</tr>
<tr id="NICHeader">
<td colspan="4"> </td>
<td>NIC #:</td>
<td> </td>
<td colspan="3">Model (and physical medium):</td>
<td> </td>
<td>MAC Address:</td>
<td> </td>
<td>Speed:</td>
<td> </td>
<td class="Scores" colspan="2"> </td>
<td> </td>
</tr>
<tr id="NIC0">
<td><input type="checkbox" id="CheckboxNIC" checked title="Deselect this checkbox if you want to exclude the network adapter(s) from the inventory." /></td>
<td><label for="CheckboxNIC"> </label></td>
<th class="Left"><label for="CheckboxNIC">NIC<span id="MultipleNICs" style="display: none;">s</span>:</label></th>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="NICIndex0" size="12" readonly title="This read-only field will display the network adapter number (zero based: 0...3)." /></td>
<td> </td>
<td colspan="3"><input type="text" oncontextmenu="javascript:this.select();" id="NICModel0" size="40" readonly title="This read-only field will display the network adapter model." /></td>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="MACAddress0" size="16" readonly title="This read-only field will display the network adapter's MAC address." /></td>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="NICSpeed0" size="16" readonly title="This read-only field will display the network adapter's link speed in kB/s." /></td>
<td> </td>
<td class="Scores" colspan="2"> </td>
<td><input id="ButtonDetailsNIC" class="Button" type="button" value=" Details " onclick="vbscript:DetailsNIC" title="Click here to display more network adapter details in a separate window." /></td>
</tr>
<tr id="NICFooter">
<td colspan="14"> </td>
<td class="Scores" colspan="2"> </td>
<td> </td>
</tr>
<tr id="MainBoardHeader">
<td colspan="4"> </td>
<td>Chassis:</td>
<td> </td>
<td colspan="3">Model:</td>
<td> </td>
<td>Manufacturer:</td>
<td> </td>
<td>Version:</td>
<td> </td>
<td class="Scores" title="This read-only field will display the Windows System Assessment Tool (WinSAT) Total Score for the computer.">Score:</td>
<td class="Scores"> </td>
<td> </td>
</tr>
<tr id="MainBoardRow">
<td><input type="checkbox" id="CheckboxMainBoard" checked title="Deselect this checkbox if you want to exclude the main board and system enclosure from the inventory." /></td>
<td><label for="CheckboxMainBoard"> </label></td>
<th class="Left"><label for="CheckboxMainBoard">Main Board:</label></th>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="ChassisType" size="12" readonly title="This read-only field will display the computer's chassis type." /></td>
<td> </td>
<td colspan="3"><input type="text" oncontextmenu="javascript:this.select();" id="MBModel" size="40" readonly title="This read-only field will display the main board type." /></td>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="MBManufacturer" size="16" readonly title="This read-only field will display the name of the main board manufacturer." /></td>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="MBVersion" size="16" readonly title="This read-only field will display the main board version." /></td>
<td> </td>
<td class="Scores"><input type="text" oncontextmenu="javascript:this.select();" id="WinSATScore" size="3" readonly title="This read-only field will display the Windows System Assessment Tool (WinSAT) Total Score for the computer." style="text-align: right;" /></td>
<td class="Scores"> </td>
<td><input id="ButtonDetailsMainBoard" class="Button" type="button" value=" Details " onclick="vbscript:DetailsMainBoard" title="Click here to display more main board and system enclosure details." /></td>
</tr>
<tr id="MainBoardFooter">
<td colspan="14"> </td>
<td class="Scores" colspan="2"> </td>
<td> </td>
</tr>
<tr id="KeyboardHeader">
<td colspan="4"> </td>
<td id="KeyboardHeaderFkLEDs">F-keys & LEDs</td>
<td> </td>
<td colspan="3">Keyboard Model:</td>
<td> </td>
<td>Keyboard Type:</td>
<td> </td>
<td>Connector:</td>
<td> </td>
<td class="Scores" colspan="2"> </td>
<td> </td>
</tr>
<tr id="KeyboardRow">
<td><input type="checkbox" id="CheckboxKeyboard" checked title="Deselect this checkbox if you want to exclude the keyboard from the inventory." /></td>
<td><label for="CheckboxKeyboard"> </label></td>
<th class="Left"><label for="CheckboxKeyboard">Keyboard:</label></th>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="KeyboardFkLEDs" size="12" readonly title="This read-only field will display the number of function keys and LEDs (elevated privileges required)." /></td>
<td> </td>
<td colspan="3"><input type="text" oncontextmenu="javascript:this.select();" id="KeyboardModel" size="40" readonly title="This read-only field will display the keyboard model." /></td>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="KeyboardType" size="16" readonly title="This read-only field will display the keyboard type." /></td>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="KeyboardConnector" size="16" readonly title="This read-only field will display the keyboard connector." /></td>
<td> </td>
<td class="Scores" colspan="2"> </td>
<td><input id="ButtonDetailsKeyboard" class="Button" type="button" value=" Details " onclick="vbscript:DetailsKeyboard" title="Click here to display more keyboard details." /></td>
</tr>
<tr id="KeyboardFooter">
<td colspan="14"> </td>
<td class="Scores" colspan="2"> </td>
<td> </td>
</tr>
<tr id="MouseHeader">
<td colspan="4"> </td>
<td id="MouseButtonsHeader">Buttons:</td>
<td> </td>
<td colspan="3">Mouse Model:</td>
<td> </td>
<td>Mouse Type:</td>
<td> </td>
<td>Connector:</td>
<td> </td>
<td class="Scores" colspan="2"> </td>
<td> </td>
</tr>
<tr id="MouseRow">
<td><input type="checkbox" id="CheckboxMouse" checked title="Deselect this checkbox if you want to exclude the mouse from the inventory." /></td>
<td><label for="CheckboxMouse"> </label></td>
<th class="Left"><label for="CheckboxMouse">Mouse:</label></th>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="MouseButtons" size="12" readonly title="This read-only field will display the number of mouse buttons (elevated privileges required)." /></td>
<td> </td>
<td colspan="3"><input type="text" oncontextmenu="javascript:this.select();" id="MouseModel" size="40" readonly title="This read-only field will display the mouse model." /></td>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="MouseType" size="16" readonly title="This read-only field will display the mouse type." /></td>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="MouseConn" size="16" readonly title="This read-only field will display the mouse connector." /></td>
<td> </td>
<td class="Scores" colspan="2"> </td>
<td><input id="ButtonDetailsMouse" class="Button" type="button" value=" Details " onclick="vbscript:DetailsMouse" title="Click here to display more mouse details." /></td>
</tr>
<tr id="MouseFooter">
<td colspan="14"> </td>
<td class="Scores" colspan="2"> </td>
<td> </td>
</tr>
<tr id="PortsHeader">
<td colspan="4"> </td>
<td>USB Ports:</td>
<td> </td>
<td colspan="3">System Slots:</td>
<td> </td>
<td>FireWire Ports:</td>
<td> </td>
<td>Legacy Ports:</td>
<td> </td>
<td class="Scores" colspan="2"> </td>
<td> </td>
</tr>
<tr id="PortsRow">
<td><input type="checkbox" id="CheckboxPorts" checked title="Deselect this checkbox if you want to exclude the ports summary from the inventory." /></td>
<td><label for="CheckboxPorts"> </label></td>
<th class="Left"><label for="CheckboxPorts">Ports:</label></th>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="USB" size="12" readonly title="This read-only field will tell if USB is supported." /></td>
<td> </td>
<td colspan="3"><input type="text" oncontextmenu="javascript:this.select();" id="Slots" size="40" readonly title="This read-only field will display the number and types of system slots (AGP/PCI)." /></td>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="FireWire" size="16" readonly title="This read-only field will display the number of IEEE 1394 Firewire ports." /></td>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="Legacy" size="16" readonly title="This read-only field will display the number of legacy parallel and serial ports." /></td>
<td> </td>
<td class="Scores" colspan="2"> </td>
<td><input id="ButtonDetailsPorts" class="Button" type="button" value=" Details " onclick="vbscript:DetailsPorts" title="Click here to display more details on the available ports." /></td>
</tr>
<tr id="PortsFooter">
<td colspan="14"> </td>
<td class="Scores" colspan="2"> </td>
<td> </td>
</tr>
<tr id="BIOSHeader">
<td colspan="4"> </td>
<td>Manufacturer:</td>
<td> </td>
<td colspan="3">Model:</td>
<td> </td>
<td>Version:</td>
<td> </td>
<td>Date:</td>
<td> </td>
<td class="Scores" colspan="2"> </td>
<td> </td>
</tr>
<tr id="BIOSRow">
<td><input type="checkbox" id="CheckboxBIOS" checked title="Deselect this checkbox if you want to exclude the BIOS from the inventory." /></td>
<td><label for="CheckboxBIOS"> </label></td>
<th class="Left"><label for="CheckboxBIOS">BIOS:</label></th>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="BIOSManufacturer" size="12" readonly title="This read-only field will display the name of the BIOS manufacturer." /></td>
<td> </td>
<td colspan="3"><input type="text" oncontextmenu="javascript:this.select();" id="BIOSModel" size="40" readonly title="This read-only field will display the BIOS description." /></td>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="BIOSVersion" size="16" readonly title="This read-only field will display the BIOS version number." /></td>
<td> </td>
<td><input type="text" oncontextmenu="javascript:this.select();" id="BIOSDate" size="16" readonly title="This read-only field will display the BIOS release date." /></td>
<td> </td>
<td class="Scores" colspan="2"> </td>
<td><input id="ButtonDetailsBIOS" class="Button" type="button" value="Details" onclick="vbscript:DetailsBIOS" title="Click here to display more BIOS details." /></td>
</tr>
<tr id="BIOSFooter">
<td colspan="14"> </td>
<td class="Scores" colspan="2"> </td>
<td> </td>
</tr>
</tbody>
</table>
<div style="height: 0.5em;"></div>
<table>
<tr>
<td><input id="ButtonCopy" class="Button" type="button" value="Copy" onclick="vbscript:CopyToClipboard" title="Click here to copy the results to the clipboard. The data in the clipboard will be in tab delimited format. Paste the data in a spreadsheet, using tab as the only delimiter, to create reports." /></td>
<td> </td>
<td><input id="ButtonSave" class="Button" type="button" value="Save" onclick="vbscript:SaveTabDelimited" title="Click here to save the results, in tab delimited format, to a file." /></td>
<td> </td>
<td><input id="ButtonPrint" class="Button" type="button" value="Print" onclick="vbscript:Print" title="Click here to print the results." accesskey="p" /></td>
<td> </td>
<td><input id="ButtonHelp" class="Button" type="button" value="Help" onclick="vbscript:ShowHelp" title="Click this button to display the Command Line Help." /></td>
<td> </td>
<td><input id="ButtonCredits" class="Button" type="button" value="Credits" onclick="vbscript:ShowCredits" title="Click this button to display the Credits window." accesskey="c" /></td>
<td> </td>
<td><input id="ButtonSettings" class="Button" type="button" value="Settings" onclick="vbscript:ShowSettings" title="Click this button to change the program settings." accesskey="s" /></td>
</tr>
</table>
</div><!-- end of "MainScreen" -->
<div id="SettingsScreen" style="display: none; max-width: 100%;" class="DontPrint">
<h1>Settings</h1>
<table>
<tr>
<td> </td>
<td class="Left Nowrap">Configuration file content</td>
<td class="Left" id="DisplayConfig" colspan="2"></td>
</tr>
<tr>
<td> </td>
<td class="Left Nowrap">Command Line</td>
<td class="Left" id="DisplayCommandLine" colspan="2"></td>
</tr>
<tr>
<td colspan="3"> </td>
</tr>
<tr title="Scale this HTA's window content">
<td> </td>
<td class="Left Nowrap">Zoom factor (50..250%)</td>
<td class="Left" colspan="2"><input type="text" id="InputZoomFactor" min="50" max="250" value="100" size="5" onchange="vbscript:ValidateZoomFactor" onkeyup="vbscript:ValidateZoomFactor" /> %</td>
</tr>
<tr title="Select to use DMIDecode for retrieving more detailed information about the local computer (ignored for remote computers or if DMIDecode.exe is not found in the PATH).">
<td><input type="checkbox" id="CheckboxDMIDecode" onclick="vbscript:OnClick_CheckboxDMIDecode" /></td>
<td class="Left" colspan="3"><label for="CheckboxDMIDecode">Use <a href="http://www.nongnu.org/dmidecode/">DMIDecode</a> for more details</label></td>
</tr>
<tr title="Select to use DxDiag for retrieving more detailed information about the local computer (ignored for remote computers).">
<td><input type="checkbox" id="CheckboxDxDiag" onclick="vbscript:OnClick_CheckboxDxDiag" /></td>
<td class="Left" colspan="3"><label for="CheckboxDxDiag">Use DxDiag for more details</label></td>
</tr>
<tr id="TablerowKeepXML" style="display: none; visibility: collapse;" title="Select to keep DxDiag's results to speed up the inventory next time.">
<td> </td>
<td class="Left Nowrap"><input type="checkbox" id="CheckboxKeepXML" /> <label for="CheckboxKeepXML">Keep DxDiag's XML file</label></td>
<td class="Left" colspan="2"><input class="Button" type="button" id="ButtonDeleteXML" value="Delete XML" onclick="vbscript:DeleteDxDiagXML" /></td>
</tr>
<tr id="TablerowDxDiagPath" style="display: none; visibility: collapse;">
<td> </td>
<td class="Left Nowrap" style="text-indent: 1.75em;">Path to DxDiag's XML file</td>
<td class="Left" colspan="2"><input type="text" id="InputDxDiag" size="30" /></td>
</tr>
<tr title="Select to include USB storage devices.">
<td><input type="checkbox" id="CheckboxUSBSTOR" /></td>
<td class="Left" colspan="3"><label for="CheckboxUSBSTOR">Include USB storage devices</label></td>
</tr>
<tr title="Select to include virtual storage devices.">
<td><input type="checkbox" id="CheckboxVirtual" /></td>
<td class="Left" colspan="3"><label for="CheckboxVirtual">Include virtual storage devices</label></td>
</tr>
<tr title="Select to display physical screen dimensions as height and width in centimeters, instead of the diagonal in inches.">
<td><input type="checkbox" id="CheckboxCM" /></td>
<td class="Left" colspan="3"><label for="CheckboxCM">Show screen width and height in centimeters instead of the diagonal in inches</label></td>
</tr>
<tr title="Deselect to skip the WinSAT scores.">
<td><input type="checkbox" id="CheckboxScores" checked /></td>
<td class="Left" colspan="3"><label for="CheckboxScores">Show WinSAT scores</label></td>
</tr>
<tr title="Select to display arrays of numbers in the details windows as interpreted text too.">
<td><input type="checkbox" id="CheckboxCharacterChains" /></td>
<td class="Left" colspan="3" title="E.g.:
Property (array) : 83,121,110,99,77,97,115,116,101,114,0
Property (string): SyncMaster
Note that not all arrays of numbers are intended to be interpreted as text, so the string may sometimes be 'jiberish'.
For this reason, property names containing 'Capability' or 'Characteristic' (or their plural forms) are excluded, as they consist of arrays of numbers NOT representing text."><label for="CheckboxCharacterChains">Show arrays of characters in details windows as text too</label></td>
</tr>
<tr title="Select to run this HTA in Debug mode.">
<td><input type="checkbox" id="CheckboxDebugMode" /></td>
<td class="Left" colspan="3"><label for="CheckboxDebugMode">Enable Debug mode</label></td>
</tr>
<tr id="TablerowDebugLog" style="display: none; visibility: collapse;">
<td> </td>
<td class="Left Nowrap">Path to debug log file</td>
<td class="Left" colspan="2"><input type="text" id="InputDebugLogPath" size="30" disabled /></td>
</tr>
<tr title="Deselect to skip the check for program updates at startup.">
<td><input type="checkbox" id="CheckboxCheckUpd" checked /></td>
<td class="Left" colspan="3"><label for="CheckboxCheckUpd">Check for updates at startup</label></td>
</tr>
<tr>
<td> </td>
<td colspan="3">Theme:</td>
</tr>
<fieldset>
<tr>
<td> </td>
<td class="Left" colspan="3"><input type="radio" name="Theme" value="BW" id="ThemeBW" onclick="vbscript:SetTheme" /><label for="ThemeBW">Default: BW (black text on white background)</label></td>
</tr>
<tr>
<td> </td>
<td class="Left" colspan="3"><input type="radio" name="Theme" value="Blue" id="ThemeBlue" onclick="vbscript:SetTheme" checked /><label for="ThemeBlue">Blue (white text on blue background)</label></td>
</tr>
<tr>
<td> </td>
<td class="Left" colspan="3"><input type="radio" name="Theme" value="Dark" id="ThemeDark" onclick="vbscript:SetTheme" /><label for="ThemeDark">Dark (white text on black background)</label></td>
</tr>
<tr>
<td> </td>
<td class="Left" colspan="3"><input type="radio" name="Theme" value="Red" id="ThemeRed" onclick="vbscript:SetTheme" /><label for="ThemeRed">Red (yellow text on red background)</label></td>
</tr>
<tr>
<td> </td>
<td class="Left" colspan="3"><input type="radio" name="Theme" value="Custom" id="ThemeCustom" onclick="vbscript:SetTheme" /><label for="ThemeCustom">Custom colors</label></td>
</tr>
</fieldset>
<tr>
<td> </td>
<td class="Left Nowrap" style="padding-left: 2em;">Background color</td>
<td class="Left"><select id="BackgroundColor" name="BackgroundColor" onchange="vbscript:SetCustomTheme"></select></td>
</tr>
<tr>
<td> </td>
<td class="Left Nowrap" style="padding-left: 2em;">Captions color</td>
<td class="Left" colspan="2"><select id="CaptionsColor" name="CaptionsColor" onchange="vbscript:SetCustomTheme"></select></td>
</tr>
<tr>
<td> </td>
<td class="Left Nowrap" style="padding-left: 2em;">Links color<!-- (<a href="#" onclick="javascript:return false;">example</a>)--></td>
<td class="Left" colspan="2"><select id="LinksColor" name="LinksColor" onchange="vbscript:SetCustomTheme"></select></td>
</tr>
<tr>
<td> </td>
<td class="Left Nowrap" style="padding-left: 2em;">Button background color</td>
<td class="Left" colspan="2"><select id="ButtonFaceColor" name="ButtonFaceColor" onchange="vbscript:SetCustomTheme"></select></td>
</tr>
<tr>
<td> </td>
<td class="Left Nowrap" style="padding-left: 2em;">Button text color</td>
<td class="Left" colspan="2"><select id="ButtonCaptionsColor" name="ButtonCaptionsColor" onchange="vbscript:SetCustomTheme"></select></td>
</tr>
<tr>
<td> </td>
<td class="Left Nowrap" style="padding-left: 2em;">Command help color<!-- (<code>example</code>)--></td>
<td class="Left" colspan="2"><select id="CodeColor" name="CodeColor" onchange="vbscript:SetCustomTheme"></select></td>
</tr>
</table>
<p> </p>
<p class="Center">
<input id="ButtonSaveCfg" class="Button" type="button" value="Save" onclick="vbscript:SaveSettings" />
<input id="ButtonEditCfg" class="Button" type="button" value="Edit" onclick="vbscript:EditSettings" accesskey="e" />
<input id="ButtonReset" class="Button" type="button" value="Reset" onclick="vbscript:ConfigReset" />
<input id="ButtonCancel" class="Button" type="button" value="Cancel" onclick="vbscript:ShowMain" />
</p>
<p> </p>
</div><!-- end of "SettingsScreen" area -->
<div id="HelpScreen" style="max-width: 900px; display: none;" class="DontPrint">
<h1>Basic Hardware Inventory, Version <span id="HelpVer">0.00</span></h1>
<p>Get a basic hardware inventory of any WMI enabled computer on the network</p>
<table class="Left" style="font-size: 10pt;">
<tr>
<td><strong>Usage:</strong></td>
<td> </td>
<td colspan="3"><code>HARDWARE.HTA [ options ] [ switches ]</code></td>
</tr>
<tr>
<td colspan="5"> </td>
</tr>
<tr>
<td><strong>Options:</strong></td>
<td> </td>
<td colspan="3">These parameters can be set in the configuration file as well as on the command line (in case of conflicts, command line options prevail)</td>
</tr>
<tr>
<td colspan="2"> </td>
<td><code>/CHAIN</code></td>
<td> </td>
<td>Experimental: In details windows, if a property value consists of an array of (character) numbers, show the <em>array</em> as well as the <em>interpreted text</em>; e.g.<br />
<code style="font-size: 80%;">PropertyValue (array) : 83,121,110,99,77,97,115,116,101,114,0,0,0<br />
PropertyValue (string): SyncMaster</code><br />
Note that not all arrays of numbers are intended to be interpreted as text, so the string may sometimes be "jiberish".
For this reason, property names containing "Capability" or "Characteristic" (or their plural forms) are excluded, as they consist of arrays of numbers <em>not</em> representing text.</td>
</tr>
<tr>
<td colspan="2"> </td>
<td><code>/CM</code></td>
<td> </td>
<td>Display monitor dimensions in centimeters instead of diagonal in inches (only in Windows Vista and later)</td>
</tr>
<tr>
<td colspan="2"> </td>
<td colspan="3"><code>/CUSTOMCOLORS:<em>gradienttop</em>;<em>gradientbottom</em>;<em>captions</em>;<em>links</em>;<em>buttonface</em>;<em>buttontext</em>;<em>commands</em></code></td>
</tr>
<tr>
<td colspan="4"> </td>
<td>Set colors for the background gradient top and bottom, body text, links, button faces, button text, and this help screen's command code (valid with <code>/THEME:Custom</code> only); for valid colors, check the dropdowns in the Settings screen or visit <a href="http://www.w3schools.com/colors/colors_names.asp">W3Schools' list of HTML colors</a></td>
</tr>
<tr>
<td colspan="2"> </td>
<td><code>/DEBUG</code></td>
<td> </td>
<td>Debug mode: list settings during startup process in a separate browser window</td>
</tr>
<tr>
<td colspan="2"> </td>
<td><code>/DMIDECODE</code></td>
<td> </td>
<td>Use <a href="http://www.nongnu.org/dmidecode/">DMIDecode.exe</a> to retrieve DMI/SMBIOS details (more information than WMI for memory, but requires third party software, and gathers information for <em>local computer only</em>)</td>
</tr>
<tr>
<td colspan="2"> </td>
<td><code>/DXDIAG</code></td>
<td> </td>
<td>Use DxDiag.exe to retrieve sound devices, video controllers and system data (more reliable than WMI for video and sound, but <em>slow</em>, and gathers information for <em>local computer only</em>)</td>
</tr>
<tr>
<td colspan="2"> </td>
<td><code>/KEEPXML</code></td>
<td> </td>
<td>Reuse existing DxDiag data saved in XML, if it exists, and do not delete the XML file when terminating the program (requires <code>/DXDIAG</code>)</td>
</tr>
<tr>
<td colspan="2"> </td>
<td><code>/NOUPD</code></td>
<td> </td>
<td>Skip check for updates at startup</td>
</tr>
<tr>
<td colspan="2"> </td>
<td><code>/NOSCORES</code></td>
<td> </td>
<td>Do not display Windows System Assessment Tool (WinSAT) scores</td>
</tr>
<tr>
<td colspan="2"> </td>
<td><code>/THEME:<em>theme</em></code></td>
<td> </td>
<td>Change the window background and text colors; <code><em>theme</em></code> can be <code>BW</code> (Black and White, default), <code>Blue</code>, <code>Dark</code>, <code>Red</code> or <code>Custom</code> (the latter requires <code>/CUSTOMCOLORS:<em>customcolors</em></code>)</td>
</tr>
<tr>
<td colspan="2"> </td>
<td><code>/USBSTOR</code></td>
<td> </td>
<td>Include USB drives in the harddisks list</td>
</tr>
<tr>
<td colspan="2"> </td>
<td><code>/VIRTUAL</code></td>
<td> </td>
<td>Include virtual drives in the harddisks list</td>
</tr>
<tr>
<td colspan="2"> </td>
<td><code>/XML:<em>xmlfile</em></code></td>
<td> </td>
<td>Location where DxDiag results will be stored; if <em>xmlfile</em> is not specified, "Hardware.xml" in the current directory will be used (requires <code>/DXDIAG</code> and <code>/KEEPXML</code>)</td>
</tr>
<tr>
<td colspan="2"> </td>
<td><code>/ZOOM:<em>zoomfactor</em></code></td>
<td> </td>
<td>Zoom factor in percents for content of this window (50..250, default 100)</td>
</tr>
<tr>
<td colspan="5"> </td>
</tr>
<tr>
<td><strong>Switches:</strong></td>
<td> </td>
<td colspan="3">These parameters can be set on the command line only</td>
</tr>
<tr>
<td colspan="2"> </td>
<td><code>/?</code> or <code>/HELP</code></td>
<td> </td>
<td>Show this message</td>
</tr>
<tr>
<td colspan="2"> </td>
<td><code>/BASIC</code></td>
<td> </td>
<td>Very basic inventory (CPU, memory, HDD)</td>
</tr>
<tr>
<td colspan="2"> </td>
<td><code>/COMPUTER:<em>computername</em></code></td>
<td> </td>
<td>Specify computer to be queried (starts inventory immediately)</td>
</tr>
<tr>
<td colspan="2"> </td>
<td><code>/COPY</code></td>
<td> </td>
<td>Copy results to clipboard and close program (starts inventory immediately, and terminates program when results are copied)</td>
</tr>
<tr>
<td colspan="2"> </td>
<td><code>/NOADMIN</code></td>
<td> </td>
<td>Skip the test for elevated privileges, just assume privileges are sufficient</td>
</tr>
<tr>
<td colspan="2"> </td>
<td><code>/PRINT</code></td>
<td> </td>
<td>Print the results to the default printer (starts inventory immediately, and terminates program when results are printed)</td>
</tr>
<tr>
<td colspan="2"> </td>
<td><code>/SAVE:<em>filename</em></code></td>
<td> </td>
<td>Save tab delimited results; if <em>filename</em> is not specified or equals "*", "Hardware.<em>computername</em>.<em>timestamp</em>.txt" in the HTA's parent folder will be used; if <em>filename</em> is a folder followed by "\*", "Hardware.<em>computername</em>.<em>timestamp</em>.txt" in the specified folder will be used (starts inventory immediately, and terminates program <em>if</em> and <em>when</em> results are written to file)</td>
</tr>
<tr>
<td colspan="2"> </td>
<td><code>/TEMPDIR:<em>tempdir</em></code></td>
<td> </td>
<td>Specify a TEMP folder with write access for the current non-admin user (used "internally" by the HTA when restarting with elevated privileges)</td>
</tr>
<tr>
<td colspan="5"> </td>
</tr>
<tr id="Notes">
<td><strong>Notes:</strong></td>
<td> </td>
<td colspan="3">At startup, the program looks for a file named "Hardware.cfg" in its working directory.
If it finds it, it will apply its settings first.<br />
Next, the command line settings are applied.
In case of conflicts, the command line parameters will prevail.<br />
Use the "Settings" button to create or edit "Hardware.cfg".<br />
"Hardware.cfg" might look like this:<br />
<code>/DMIDecode /DxDiag /KeepXML /USBStor</code></td>
</tr>
<tr>
<td colspan="5"> </td>
</tr>
<tr>
<td colspan="2"> </td>
<td colspan="3">If the program detects that it runs in a WinPE environment, neither DxDiag nor DMIDecode can be used.<br />
In that case, the switches <code>/DMIDecode</code>, <code>/DxDiag</code>, <code>/KeepXML</code> and <code>/XML</code> will all be ignored.<br />
The switch <code>/NOADMIN</code> will not be required in a WinPE environment, as the program will have admin privileges by default in WinPE.<br />
Note that WMI results in a WinPE environment WMI may be different from the ones returned in a "normal" Windows environment.</td>
</tr>
<tr>
<td colspan="5"> </td>
</tr>
<tr>
<td><strong>Examples:</strong></td>
<td> </td>
<td colspan="3"><code>HARDWARE.HTA /DMIDecode /DxDiag /KeepXML /USBStor</code></td>
</tr>
<tr>
<td colspan="5"> </td>
</tr>
<tr>
<td colspan="2"> </td>
<td colspan="3"><code>HARDWARE.HTA /NoUpd /DMIDecode /DxDiag /Save:%ComputerName%_Full_Inventory.txt</code></td>
</tr>
<tr>
<td colspan="5"> </td>
</tr>
<tr>
<td colspan="2"> </td>
<td colspan="3"><code>HARDWARE.HTA /NoUpd /Basic /Computer:REMOTEPC /Save:REMOTEPC_Basic_Inventory.txt</code></td>
</tr>
<tr>
<td colspan="5"> </td>
</tr>
<tr>
<td><strong>Keyboard:</strong></td>
<td> </td>
<td colspan="3">Besides Windows' standard "global" keyboard shortcuts, this HTA supports the following keyboard shortcuts:</td>
</tr>
<tr>
<td colspan="5"> </td>
</tr>
<tr>
<td> </td>
<td> </td>
<td><code>F1</code></td>
<td> </td>
<td><strong>Help</strong></td>
</tr>
<tr>
<td> </td>
<td> </td>
<td><code>Backspace</code></td>
<td> </td>
<td><strong>Back</strong> to Main window (only when in Help or Credits window)</td>
</tr>
<tr>
<td> </td>
<td> </td>
<td><code>Esc</code></td>
<td> </td>
<td><strong>Back</strong> to Main window (only when in Settings, Help or Credits window)</td>
</tr>
<tr>
<td> </td>
<td> </td>
<td><code>Alt+B</code></td>
<td> </td>
<td>Select <strong><u>B</u>asic</strong> inventory</td>
</tr>
<tr>
<td> </td>
<td> </td>
<td><code>Alt+C</code></td>
<td> </td>
<td><strong><u>C</u>redits</strong></td>
</tr>
<tr>
<td> </td>
<td> </td>
<td><code>Alt+D</code></td>
<td> </td>
<td>Toggle <strong><u>D</u>ebug</strong> mode on/off (best started with <code>/DEBUG</code> command line switch)</td>
</tr>
<tr>
<td> </td>
<td> </td>
<td><code>Alt+E</code></td>
<td> </td>
<td><strong><u>E</u>dit</strong> the configuration file (in Settings screen only)</td>
</tr>
<tr>
<td> </td>
<td> </td>
<td><code>Alt+F</code></td>
<td> </td>
<td>Select <strong><u>F</u>ull</strong> inventory</td>
</tr>
<tr>
<td> </td>
<td> </td>
<td><code>Alt+G</code></td>
<td> </td>
<td><strong><u>G</u>o</strong> (start the inventory)</td>
</tr>
<tr>
<td> </td>
<td> </td>
<td><code>Alt+P</code></td>
<td> </td>
<td><strong>Print <u>P</u>review</strong> in default browser (output in black and white)</td>
</tr>
<tr>
<td> </td>
<td> </td>
<td><code>Alt+R</code></td>
<td> </td>
<td><strong><u>R</u>eset</strong> main window (only <em>after</em> running the inventory)</td>
</tr>
<tr>
<td> </td>
<td> </td>
<td><code>Alt+S</code></td>
<td> </td>
<td><strong><u>S</u>ettings</strong></td>
</tr>
<tr>
<td> </td>
<td> </td>
<td><code>Ctrl+P</code></td>
<td> </td>
<td><strong><u>P</u>rint</strong> (output in the HTA's screen colors)</td>
</tr>
</table>
<p> </p>
<p class="Left">If you like this program, why not show your appreciation by making a donation?</p>
<p class="Left">Click <input type="button" class="Button" value="Donate" onclick="vbscript:ShowDonate" style="vertical-align: middle;" /> or navigate to <a href="https://www.robvanderwoude.com/donate.php">https://www.robvanderwoude.com/donate.php</a></p>
<p class="Left">Your support is highly appreciated.</p>
<p> </p>
</div><!-- end of "HelpScreen" area -->
<div id="CreditsScreen" class="DontPrint">
<h1>Credits</h1>
<h2>Basic Hardware Inventory, Version <span id="CredVersion">0.00</span></h2>
<p> </p>
<div class="Left">
<p>This program in its current state could not have been created without the help of others.<br />
Thanks to all the people involved, whether mentioned here or not.</p>
<p>The program was created using the Microsoft Scripting Guys' Scriptomatic 2.0 and HTA Helpomatic tools, and Adersoft's HTAEdit (now embedded in <a href="https://vbsedit.com/">VbsEdit</a>).</p>
<p>The decision to use the <code>MSFT_PhysicalDisk</code> class in the <code>root/Microsoft/Windows/Storage</code> namespace instead of the <code>Win32_DiskDrive</code> class in the <code>root/CIMV2</code> namespace to get more reliable results was based on a <a href="https://www.pdq.com/blog/determining-disk-type-with-get-physicaldisk/">PowerShell script by Kris Powell</a>.</p>
<p>The code to handle video memory over 4 GB was based on <a href="https://superuser.com/questions/1461858/fetch-correct-vram-for-gpu-via-command-line-on-windows/1497378#1497378">PowerShell code by "farag"</a>.</p>
<p>The Chassis routine was based on a <a href="https://www.computerperformance.co.uk/ezine/ezine94/">script by Guy Thomas</a>.</p>
<p>The HandleClass routine was based on the Microsoft TechNet ScriptCenter article "Scripting Eye for the GUI Guy".</p>
<p>WinPE detection was based on a <a href="https://techgenix.com/HowtodetectwhetheryouareinWindowsPE/">tip by Mitch Tulloch</a>.</p>
<p>The code to <a href="https://www.sccmog.com/get-current-old-machine-name-winpe-vbscript/">find the computer name in WinPE</a> was based on Richie Schuster's.</p>
<p>Trick to <a href="http://blog.sevagas.com/?Hacking-around-HTA-files">embed an icon in the HTA</a> by Emeric Nasi.</p>
<p>Steve Robertson thoroughly tested the program and sent me many bug reports, fixes, and suggestions for improvements.</p>
<p>Gary Johnson suggested to use DxDiag for video properties, and he also assisted in testing the DxDiag feature.</p>
<p>DMI (SMBIOS) details for the local computer are retrieved by <a href="https://gnuwin32.sourceforge.net/packages/dmidecode.htm">DMIDecode for Windows</a>, if installed.</p>
<p> </p>
<p>If you like this program, why not show your appreciation by making a donation?</p>
<p>Click <input type="button" class="Button" value="Donate" onclick="vbscript:ShowDonate" style="vertical-align: middle;" /> or navigate to <a href="https://www.robvanderwoude.com/donate.php">https://www.robvanderwoude.com/donate.php</a></p>
<p class="Left">Your support is highly appreciated.</p>
</div><!-- end of left alignment -->
<p> </p>
</div><!-- end of "CreditsScreen" area -->
<div id="PrintScreen" class="PrintOnly">
<p>This field will contain the results of the last inventory; it is used for "fast" printing with Ctrl+P only.</p>
</div><!-- end of "PrintScreen" area -->
<div class="DontPrint">
<p>Basic Hardware Inventory, Version <span id="AppVersion">0.00</span><br />
<span style="font-size: 80%;">© 2005 - <span id="AppYear">2016</span>, Rob van der Woude<br />
<a href="https://www.robvanderwoude.com/hardware.php">https://www.robvanderwoude.com/hardware.php</a></span></p>
<p> </p>
<p id="Back" style="display: none;"><input type="button" class="Button" value="Back" onclick="vbscript:ShowMain" /></p>
<p> </p>
</div><!-- end of "DontPrint" area -->
</div><!-- end of centered text -->
</body>
</html>
page last modified: 2024-04-16; loaded in 0.1453 seconds