Rob van der Woude's Scripting Pages
Powered by GeSHi

Source code for hardware.hta

(view source code of hardware.hta as plain text)

  1. <!DOCTYPE HTML>
  2. <html lang="en">
  3. <head>
  4. <title>Basic Hardware Inventory</title>
  5.  
  6. <meta name="viewport" content="width=device-width; initial-scale=1" />
  7.  
  8. <HTA:APPLICATION
  9.   APPLICATIONNAME="Basic Hardware Inventory"
  10.   ID="Hardware"
  11.   VERSION="9.02"
  12.   ICON="Hardware.ico"
  13.   SCROLL="auto"
  14.   SINGLEINSTANCE="yes"
  15.   WINDOWSTATE="maximize"/>
  16.  
  17. <style type="text/css">
  1. html {
  2. 	height: 100%;
  3. }
  4.  
  5. body {
  6. 	font: 11pt arial,sans-serif;
  7. 	color: black;
  8. 	background-color: white;
  9. 	padding: 20px 0;
  10. 	margin: 0;
  11. 	height: 100%;
  12. 	width: 100%;
  13. }
  14.  
  15. a {
  16. 	color: red;
  17. }
  18.  
  19. code {
  20. 	color: yellow;
  21. 	font-size: 110%;
  22. }
  23.  
  24. input[type=radio] {
  25. 	width: 2em;
  26. }
  27.  
  28. table {
  29. 	max-width: 100%;
  30. }
  31.  
  32. td {
  33. 	overflow-x: auto;
  34. 	text-align: left;
  35. }
  36.  
  37. tr {
  38. 	vertical-align: top;
  39. }
  40.  
  41. .Button {
  42. 	height: 2em;
  43. 	margin: 0 1em 0 1em;
  44. 	overflow: visible;
  45. 	padding: 2px;
  46. 	vertical-align: middle;
  47. 	width: 6em;
  48. }
  49.  
  50. .Center {
  51. 	margin-left: auto;
  52. 	margin-right: auto;
  53. 	text-align: center;
  54. }
  55.  
  56. .DebugOnly {
  57. 	display: none;
  58. }
  59.  
  60. .Left {
  61. 	text-align: left;
  62. }
  63.  
  64. .Nowrap {
  65. 	white-space: nowrap;
  66. }
  67.  
  68. .Top {
  69. 	vertical-align: top;
  70. }
  71.  
  72. #CreditsScreen, #HelpScreen {
  73. 	display: none;
  74. 	margin: 0 auto;
  75. 	max-width: 90%;
  76. 	width: 800px;
  77. }
  78.  
  79. #CreditsScreen .Button, #HelpScreen .Button {
  80. 	margin: 3px;
  81. }
  82.  
  83. #HelpScreen table tr td {
  84. 	text-align: left;
  85. }
  86.  
  87. @media screen
  88. {
  89. 	.PrintOnly {
  90. 		display: none;
  91. 	}
  92. }
  93.  
  94. @media print
  95. {
  96. 	body {
  97. 		font: 12pt arial,sans-serif;
  98. 		color: black;
  99. 		background-color: white;
  100. 		filter: unset;
  101. 		padding: 0;
  102. 		margin: 0;
  103. 		height: 100%;
  104. 	}
  105.  
  106. 	.DontPrint {
  107. 		display: none;
  108. 	}
  109.  
  110. 	.Nowrap {
  111. 		white-space: normal;
  112. 	}
  113. }
  1. </style>
  2. </head>
  3.  
  4. <script language="VBScript">
  1. Option Explicit
  2.  
  3. ' File IO constants
  4. Const TristateFalse      =  0
  5. Const TristateMixed      = -2
  6. Const TristateTrue       = -1
  7. Const TristateUseDefault = -2
  8.  
  9. Const ForAppending = 8
  10. Const ForReading   = 1
  11. Const ForWriting   = 2
  12.  
  13. ' Registry hives constants
  14. Const HKEY_CLASSES_ROOT   = &H80000000
  15. Const HKEY_CURRENT_USER   = &H80000001
  16. Const HKEY_LOCAL_MACHINE  = &H80000002
  17. Const HKEY_USERS          = &H80000003
  18. Const HKEY_CURRENT_CONFIG = &H80000005
  19.  
  20. ' Registry data types constants
  21. Const REG_SZ                         =  1
  22. Const REG_EXPAND_SZ                  =  2
  23. Const REG_BINARY                     =  3
  24. Const REG_DWORD                      =  4
  25. Const REG_DWORD_BIG_ENDIAN           =  5
  26. Const REG_LINK                       =  6
  27. Const REG_MULTI_SZ                   =  7
  28. Const REG_RESOURCE_LIST              =  8
  29. Const REG_FULL_RESOURCE_DESCRIPTOR   =  9
  30. Const REG_RESOURCE_REQUIREMENTS_LIST = 10
  31. Const REG_QWORD                      = 11
  32.  
  33. ' Character and year to be displayed in copyrights notices
  34. Const COPYRIGHTS_YEAR = 2023
  35. Dim COPYRIGHTS_CHAR
  36. COPYRIGHTS_CHAR = Chr( 169 ) ' May need correction in non-latin languages
  37.  
  38. Const KB = 1024
  39. Const MB = 1048576 ' 1024 * 1024
  40. Const GB = 1073741824 ' 1024 * 1024 * 1024
  41. Const TB = 1099511627776 ' 1024 * 1024 * 1024 * 1024
  42.  
  43. ' Variable to get elevation status
  44. Dim gvbIsElevated
  45.  
  46. ' Variable to hold local/remote check result
  47. Dim gvbIsLocalComputer
  48.  
  49. ' Variables to hold the command line
  50. Dim gvsCommandline, gvsCommandlineUC
  51.  
  52. ' Global File System Object
  53. Dim gvoFSO
  54.  
  55. ' Global variables to receive the WinSAT scores
  56. Dim sngCPU, sngDisk, sngMemory, sngTotal, sngVideo
  57.  
  58. ' Minimum window size
  59. Dim gviMinHeight, gviMinWidth
  60.  
  61. ' Configuration file
  62. Dim gvsConfigFile
  63.  
  64. ' Temporary files to display detailed query results and print previews
  65. Dim gvsDetailsFile, gvsPrintFile
  66.  
  67. ' Path to DMIDecode.exe
  68. Dim gvsDMIDecode
  69.  
  70. ' Dictionary objects to hold all defaults, permanent settings and session settings
  71. Dim gvaDefaultsBool, gvaDefaultsStr, gvaSettingsBool, gvaSettingsStr
  72.  
  73. ' Internet connection available?
  74. Dim gvbConnected
  75. gvbConnected = True
  76.  
  77. ' Random generator
  78. Dim gvoRandom
  79.  
  80. ' Registry DataTypes to string
  81. Dim gvaRegDataType(11)
  82. gvaRegDataType(1)  = "REG_SZ"
  83. gvaRegDataType(2)  = "REG_EXPAND_SZ"
  84. gvaRegDataType(3)  = "REG_BINARY"
  85. gvaRegDataType(4)  = "REG_DWORD"
  86. gvaRegDataType(5)  = "REG_DWORD_BIG_ENDIAN"
  87. gvaRegDataType(6)  = "REG_LINK"
  88. gvaRegDataType(7)  = "REG_MULTI_SZ"
  89. gvaRegDataType(8)  = "REG_RESOURCE_LIST"
  90. gvaRegDataType(9)  = "REG_FULL_RESOURCE_DESCRIPTOR"
  91. gvaRegDataType(10) = "REG_RESOURCE_REQUIREMENTS_LIST"
  92. gvaRegDataType(11) = "REG_QWORD"
  93.  
  94. ' WMI objects for all namespaces used in this HTA
  95. Dim gvoWMIlocalCimv2, gvoWMIrootCimv2, gvoWMIrootMSWinStorage, gvoWMIrootStandardCimv2, gvoWMIrootWMI
  96.  
  97. ' Other global variables
  98. Dim gvaCSSColors, gvaPATH, gvaVideo( )
  99. Dim gvbSilent, gvbWinPE
  100. Dim clrBgErr, clrTxtErr
  101. Dim gvcBanks, gvcCPU, gvcMemory
  102. Dim gviNumOS, gviMemSize, gviMemSpeed
  103. Dim gvoHDDInterfaces, gvoWSHShell
  104. Dim gvsDefaultBrowserName, gvsDefaultBrowserPath
  105. Dim gvsBIOSSerial, gvsComputer, gvsCSVTxt, gvsDebugText, gvsDetails, gvsHeader, gvsPATH, gvsSlots, gvsWinDrive
  106.  
  107.  
  108. Sub window_onload
  109. 	Dim blnComputer, strFile
  110.  
  111. 	' Global File System and WSH Shell objects must be initialized here because they are requireded now, before Initialize( ) subroutine has run
  112. 	Set gvoWSHShell      = CreateObject( "WScript.Shell" )
  113. 	Set gvoFSO           = CreateObject( "Scripting.FileSystemObject" )
  114. 	Set gvoWMIlocalCimv2 = GetObject( "winmgmts://./root/CIMV2" )
  115.  
  116. 	' Check if in WinPE
  117. 	gvbWinPE = CheckWinPE( )
  118.  
  119. 	' Initialize the program window
  120. 	AppVersion.innerHTML  = Hardware.Version
  121. 	HelpVer.innerHTML     = Hardware.Version
  122. 	CredVersion.innerHTML = Hardware.Version
  123. 	AppYear.innerHTML     = COPYRIGHTS_YEAR
  124. 	document.title = "Basic Hardware Inventory (Version " & Hardware.Version & ") " & COPYRIGHTS_CHAR & " 2005 - " & COPYRIGHTS_YEAR & ", Rob van der Woude"
  125.  
  126. 	' Initialize the program
  127. 	Initialize ' includes read and set defaults
  128. 	ConfigReadFile
  129. 	ConfigReadCommandline
  130. 	ConfigUpdateStatus
  131.  
  132. 	ButtonCopy.disabled  = True
  133. 	ButtonPaste.disabled = False
  134. 	ButtonPrint.disabled = True
  135. 	ButtonSave.disabled  = True
  136. 	If gvaSettingsBool.Item( "BASIC" ) Then
  137. 		ButtonBasic.value = "Full"
  138. 	End If
  139. 	CheckboxBIOS.Checked            = Not gvaSettingsBool.Item( "BASIC" )
  140. 	CheckboxCDROM.Checked           = Not gvaSettingsBool.Item( "BASIC" )
  141. 	CheckboxCPU.Checked             = True
  142. 	CheckboxFDD.Checked             = Not gvaSettingsBool.Item( "BASIC" )
  143. 	CheckboxHDD.Checked             = True
  144. 	CheckboxKeyboard.Checked        = Not gvaSettingsBool.Item( "BASIC" )
  145. 	CheckboxMainBoard.Checked       = Not gvaSettingsBool.Item( "BASIC" )
  146. 	CheckboxMemory.Checked          = True
  147. 	CheckboxMonitor.Checked         = Not gvaSettingsBool.Item( "BASIC" )
  148. 	CheckboxMouse.Checked           = Not gvaSettingsBool.Item( "BASIC" )
  149. 	CheckboxNIC.Checked             = Not gvaSettingsBool.Item( "BASIC" )
  150. 	CheckboxPorts.Checked           = Not gvaSettingsBool.Item( "BASIC" )
  151. 	CheckboxVideo.Checked           = Not gvaSettingsBool.Item( "BASIC" )
  152. 	CheckboxSound.Checked           = Not gvaSettingsBool.Item( "BASIC" )
  153. 	ButtonDetailsBIOS.disabled      = True
  154. 	ButtonDetailsCPU.disabled       = True
  155. 	ButtonDetailsCDROM.disabled     = True
  156. 	ButtonDetailsFDD.disabled       = True
  157. 	ButtonDetailsHDD.disabled       = True
  158. 	ButtonDetailsKeyboard.disabled  = True
  159. 	ButtonDetailsMainBoard.disabled = True
  160. 	ButtonDetailsMemory.disabled    = True
  161. 	ButtonDetailsMonitor.disabled   = True
  162. 	ButtonDetailsMouse.disabled     = True
  163. 	ButtonDetailsNIC.disabled       = True
  164. 	ButtonDetailsPorts.disabled     = True
  165. 	ButtonDetailsSound.disabled     = True
  166. 	ButtonDetailsVideo.disabled     = True
  167.  
  168. 	If InStr( gvsCommandlineUC, "/?" ) Or InStr( gvsCommandlineUC, "/HELP" ) Then showHelp
  169.  
  170. 	If gvaSettingsBool.Item( "DEVTEST" ) Then Set gvoRandom = CreateObject( "System.Random" )
  171.  
  172. 	window.offscreenBuffering = True
  173.  
  174. 	gviNumOS = GetOSVer( )
  175. 	If Split( gviNumOS, "." )(0) < 8 Then
  176. 		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"
  177. 		self.window.close
  178. 		Exit Sub
  179. 	End If
  180.  
  181. 	GetDefaultBrowser
  182.  
  183. 	If Not IsAdmin( True ) Then
  184. 		Self.window.close
  185. 		Exit Sub
  186. 	End If
  187.  
  188. 	blnComputer = CBool( InStr( gvsCommandlineUC, "/COMPUTER:" ) )
  189. 	gvbSilent   = gvaSettingsBool.Item( "COPY" ) Or gvaSettingsBool.Item( "PRINT" ) Or ( gvaSettingsStr.Item( "SAVE" ) <> "" )
  190. 	If gvbSilent Or blnComputer Then Inventory
  191. 	If gvbSilent Then
  192. 		If gvaSettingsBool.Item( "COPY" )      Then CopyToClipboard
  193. 		If gvaSettingsBool.Item( "PRINT" )     Then Print
  194. 		If gvaSettingsStr.Item( "SAVE" ) <> "" Then strFile = SaveTabDelimited( )
  195. 		window.close
  196. 		Exit Sub
  197. 	End If
  198.  
  199. 	' Start a separate thread/process for the update check
  200. 	setTimeout "CheckUpdate", 100, "VBScript"
  201.  
  202. 	ComputerName.focus
  203. End Sub
  204.  
  205.  
  206. Sub Add2CsvBIOS( )
  207. 	gvsHeader = gvsHeader _
  208. 	          & vbTab & "BIOS Manufacturer:" _
  209. 	          & vbTab & "BIOS Model:"   _
  210. 	          & vbTab & "BIOS Version:" _
  211. 	          & vbTab & "BIOS Date:"    _
  212. 	          & vbTab & "BIOS Serial Number:"
  213. 	On Error Resume Next ' REQUIRED
  214. 	gvsCSVTxt = gvsCSVTxt & vbTab
  215. 	gvsCSVTxt = gvsCSVTxt & BIOSManufacturer.value
  216. 	gvsCSVTxt = gvsCSVTxt & vbTab
  217. 	gvsCSVTxt = gvsCSVTxt & BIOSModel.value
  218. 	gvsCSVTxt = gvsCSVTxt & vbTab
  219. 	gvsCSVTxt = gvsCSVTxt & BIOSVersion.value
  220. 	gvsCSVTxt = gvsCSVTxt & vbTab
  221. 	gvsCSVTxt = gvsCSVTxt & BIOSDate.value
  222. 	gvsCSVTxt = gvsCSVTxt & vbTab
  223. 	gvsCSVTxt = gvsCSVTxt & gvsBIOSSerial
  224. 	On Error GoTo 0
  225. End Sub
  226.  
  227.  
  228. Sub Add2CsvCDROM( )
  229. 	Dim i
  230. 	On Error Resume Next ' REQUIRED
  231. 	For i = 0 To 64
  232. 		gvsCSVTxt = gvsCSVTxt _
  233. 		          & vbTab & document.getElementById( "CDROM" & i & "Model"     ).value _
  234. 		          & vbTab & document.getElementById( "CDROM" & i & "Firmware"  ).value _
  235. 		          & vbTab & document.getElementById( "CDROM" & i & "Interface" ).value
  236. 		If Err Then
  237. 			Exit For
  238. 		Else
  239. 			gvsHeader = gvsHeader _
  240. 			           & vbTab & "CDROM " & i & " Model:"    _
  241. 			           & vbTab & "CDROM " & i & " Firmware:" _
  242. 			           & vbTab & "CDROM " & i & " Interface:"
  243. 		End if
  244. 	Next
  245. 	On Error GoTo 0
  246. End Sub
  247.  
  248.  
  249. Sub Add2CsvCPU
  250. 	gvsHeader = gvsHeader _
  251. 	          & vbTab & "# CPUs:" _
  252. 	          & vbTab & "CPU Type:" _
  253. 	          & vbTab & "CPU Speed:" _
  254. 	          & vbTab & "CPU Socket:" _
  255. 	          & vbTab & "WinSat CPU Score:"
  256. 	On Error Resume Next ' REQUIRED
  257. 	gvsCSVTxt = gvsCSVTxt & vbTab
  258. 	gvsCSVTxt = gvsCSVTxt & CPUNumber.value
  259. 	gvsCSVTxt = gvsCSVTxt & vbTab
  260. 	gvsCSVTxt = gvsCSVTxt & CPUModel.value
  261. 	gvsCSVTxt = gvsCSVTxt & vbTab
  262. 	gvsCSVTxt = gvsCSVTxt & CPUSpeed.value
  263. 	gvsCSVTxt = gvsCSVTxt & vbTab
  264. 	gvsCSVTxt = gvsCSVTxt & CPUSocket.value
  265. 	gvsCSVTxt = gvsCSVTxt & vbTab
  266. 	gvsCSVTxt = gvsCSVTxt & CPUScore.value
  267. 	On Error GoTo 0
  268. End Sub
  269.  
  270.  
  271. Sub Add2CsvFDD( )
  272. 	Dim i
  273. 	On Error Resume Next ' REQUIRED
  274. 	For i = 0 To 256
  275. 		gvsCSVTxt = gvsCSVTxt _
  276. 		          & vbTab & document.getElementById( "FDD" & i & "DeviceID"    ).value _
  277. 		          & vbTab & document.getElementById( "FDD" & i & "Description" ).value _
  278. 		          & vbTab & document.getElementById( "FDD" & i & "Capacity"    ).value _
  279. 		          & vbTab & document.getElementById( "FDD" & i & "Interface"   ).value
  280. 		If Err Then
  281. 			Exit For
  282. 		Else
  283. 				gvsHeader = gvsHeader _
  284. 				          & vbTab & "FDD " & i & " Drive:"       _
  285. 				          & vbTab & "FDD " & i & " Description:" _
  286. 				          & vbTab & "FDD " & i & " Capacity:"    _
  287. 				          & vbTab & "FDD " & i & " Interface:"
  288. 		End If
  289. 	Next
  290. 	On Error GoTo 0
  291. End Sub
  292.  
  293.  
  294. Sub Add2CsvHDD( )
  295. 	Dim i
  296. 	On Error Resume Next ' REQUIRED
  297. 	For i = 0 To 256
  298. 		gvsCSVTxt = gvsCSVTxt _
  299. 		          & vbTab & document.getElementById( "HardDisk" & i & "Model"     ).value _
  300. 		          & vbTab & document.getElementById( "HardDisk" & i & "Size"      ).value _
  301. 		          & vbTab & document.getElementById( "HardDisk" & i & "Interface" ).value
  302. 		If Err Then
  303. 			Exit For
  304. 		Else
  305. 				gvsHeader = gvsHeader _
  306. 				          & vbTab & "HDD " & i & " Model:"     _
  307. 				          & vbTab & "HDD " & i & " Size (GB):" _
  308. 				          & vbTab & "HDD " & i & " Interface:"
  309. 		End If
  310. 	Next
  311. 	On Error GoTo 0
  312. 	gvsHeader = gvsHeader & vbTab & "WinSat Disk Score:"
  313. 	gvsCSVTxt = gvsCSVTxt & vbTab & DiskScore.value
  314. End Sub
  315.  
  316.  
  317. Sub Add2CsvKbd( )
  318. 	gvsHeader = gvsHeader _
  319. 	          & vbTab & "Keyboard Type:" _
  320. 	          & vbTab & "Keyboard Model:"
  321. 	On Error Resume Next ' REQUIRED
  322. 	gvsCSVTxt = gvsCSVTxt & vbTab
  323. 	gvsCSVTxt = gvsCSVTxt & KeyboardType.value
  324. 	gvsCSVTxt = gvsCSVTxt & vbTab
  325. 	gvsCSVTxt = gvsCSVTxt & KeyboardModel.value
  326. 	On Error GoTo 0
  327. End Sub
  328.  
  329.  
  330. Sub Add2CsvMainBoard( )
  331. 	gvsHeader = gvsHeader            & vbTab _
  332. 	          & "Chassis:"           & vbTab _
  333. 	          & "MB Manufacturer:"   & vbTab _
  334. 	          & "MB Model:"          & vbTab _
  335. 	          & "MB Version:"        & vbTab _
  336. 	          & "WinSAT Score:"
  337. 	gvsCSVTxt = gvsCSVTxt            & vbTab _
  338. 	          & ChassisType.value    & vbTab _
  339. 	          & MBManufacturer.value & vbTab _
  340. 	          & MBModel.value        & vbTab _
  341. 	          & MBVersion.value      & vbTab _
  342. 	          & WinSATScore.value
  343. End Sub
  344.  
  345.  
  346. Sub Add2CsvMemory
  347. 	gvsHeader = gvsHeader _
  348. 	          & vbTab & "# Memory Banks:" _
  349. 	          & vbTab & "# Memory Modules:" _
  350. 	          & vbTab & "Total Memory (MB):" _
  351. 	          & vbTab & "Memory Speed (ns):" _
  352. 	          & vbTab & "Memory FormFactor:" _
  353. 	          & vbTab & "WinSat Memory Score:"
  354.     On Error Resume Next ' REQUIRED
  355.     gvsCSVTxt = gvsCSVTxt & vbTab
  356.     gvsCSVTxt = gvsCSVTxt & gvcBanks
  357.     gvsCSVTxt = gvsCSVTxt & vbTab
  358.     gvsCSVTxt = gvsCSVTxt & gvcMemory
  359.     gvsCSVTxt = gvsCSVTxt & vbTab
  360.     gvsCSVTxt = gvsCSVTxt & MemorySize.value
  361.     gvsCSVTxt = gvsCSVTxt & vbTab
  362.     gvsCSVTxt = gvsCSVTxt & MemorySpeed.value
  363.     gvsCSVTxt = gvsCSVTxt & vbTab
  364.     gvsCSVTxt = gvsCSVTxt & MemoryFormFactor.value
  365.     gvsCSVTxt = gvsCSVTxt & vbTab
  366.     gvsCSVTxt = gvsCSVTxt & MemoryScore.value
  367. 	On Error GoTo 0
  368. End Sub
  369.  
  370.  
  371. Sub Add2CsvMouse( )
  372. 	gvsHeader = gvsHeader _
  373. 	          & vbTab & "Mouse Type:"    _
  374. 	          & vbTab & "Mouse Model:"
  375. 	On Error Resume Next ' REQUIRED
  376. 	gvsCSVTxt = gvsCSVTxt & vbTab
  377. 	gvsCSVTxt = gvsCSVTxt & MouseType.value
  378. 	gvsCSVTxt = gvsCSVTxt & vbTab
  379. 	gvsCSVTxt = gvsCSVTxt & MouseModel.value
  380. 	On Error GoTo 0
  381. End Sub
  382.  
  383.  
  384. Sub Add2CsvNIC
  385. 	Dim i
  386. 	On Error Resume Next ' REQUIRED
  387. 	For i = 0 To 64
  388. 		gvsCSVTxt = gvsCSVTxt _
  389. 		          & vbTab & document.getElementById( "NICModel" & i ).value _
  390. 		          & vbTab & document.getElementById( "MACAddress" & i ).value _
  391. 		          & vbTab & document.getElementById( "NICSpeed" & i ).value
  392. 		If Err Then
  393. 			Exit For
  394. 		Else
  395. 			gvsHeader = gvsHeader _
  396. 			          & vbTab & "NIC " & i & " Model (and medium):" _
  397. 			          & vbTab & "NIC " & i & " MAC Address:" _
  398. 			          & vbTab & "NIC " & i & " Speed:"
  399. 		End if
  400. 	Next
  401. 	On Error GoTo 0
  402. End Sub
  403.  
  404.  
  405. Sub Add2CsvPorts
  406. 	gvsHeader = gvsHeader _
  407. 	          & vbTab & "USB:" _
  408. 	          & vbTab & "System Slots:" _
  409. 	          & vbTab & "Parallel Ports:" _
  410. 	          & vbTab & "Serial Ports:"
  411. 	On Error Resume Next ' REQUIRED
  412. 	gvsCSVTxt = gvsCSVTxt & vbTab
  413. 	gvsCSVTxt = gvsCSVTxt & USB.value
  414. 	gvsCSVTxt = gvsCSVTxt & vbTab
  415. 	gvsCSVTxt = gvsCSVTxt & gvsSlots
  416. 	gvsCSVTxt = gvsCSVTxt & vbTab
  417. 	gvsCSVTxt = gvsCSVTxt & Parallel.value
  418. 	gvsCSVTxt = gvsCSVTxt & vbTab
  419. 	gvsCSVTxt = gvsCSVTxt & Serial.value
  420. 	On Error GoTo 0
  421. End Sub
  422.  
  423.  
  424. Sub Add2CsvSound
  425. 	gvsHeader = gvsHeader _
  426. 	          & vbTab & "Sound Card Model:" _
  427. 	          & vbTab & "Sound Card Manufacturer:"
  428. 	On Error Resume Next ' REQUIRED
  429. 	gvsCSVTxt = gvsCSVTxt & vbTab
  430. 	gvsCSVTxt = gvsCSVTxt & SoundCardManufacturer.value
  431. 	gvsCSVTxt = gvsCSVTxt & vbTab
  432. 	gvsCSVTxt = gvsCSVTxt & SoundCardModel.value
  433. 	On Error GoTo 0
  434. End Sub
  435.  
  436.  
  437. Sub Add2CsvVideo( )
  438. 	Dim i
  439. 	On Error Resume Next ' REQUIRED
  440. 	For i = 0 To 32
  441. 		gvsCSVTxt = gvsCSVTxt _
  442. 		          & vbTab & document.getElementById( "VideoModel"  & i ).value _
  443. 		          & vbTab & document.getElementById( "VideoMemory" & i ).value _
  444. 		          & vbTab & document.getElementById( "VideoMode"   & i ).value
  445. 		If Err Then
  446. 			Exit For
  447. 		Else
  448. 			gvsHeader = gvsHeader _
  449. 			          & vbTab & "Video " & i & " Model:" _
  450. 			          & vbTab & "Video " & i & " Memory (MB):" _
  451. 			          & vbTab & "Video " & i & " Mode:"
  452. 		End If
  453. 	Next
  454. 	gvsCSVTxt = gvsCSVTxt & vbTab & GraphicsScore.value
  455. 	gvsHeader = gvsHeader & vbTab & "WinSat Graphics Score:"
  456. 	On Error GoTo 0
  457. End Sub
  458.  
  459.  
  460. Function Align( myString, myLength )
  461. 	Align = Left( myString & Space( myLength ), myLength )
  462. End Function
  463.  
  464.  
  465. Sub Basic( )
  466. 	gvaSettingsBool.Item( "BASIC" ) = Not gvaSettingsBool.Item( "BASIC" )
  467. 	CheckboxBIOS.Checked            = Not gvaSettingsBool.Item( "BASIC" )
  468. 	CheckboxCDROM.Checked           = Not gvaSettingsBool.Item( "BASIC" )
  469. 	CheckboxCPU.Checked             = True
  470. 	CheckboxHDD.Checked             = True
  471. 	CheckboxFDD.Checked             = Not gvaSettingsBool.Item( "BASIC" )
  472. 	CheckboxKeyboard.Checked        = Not gvaSettingsBool.Item( "BASIC" )
  473. 	CheckboxMainBoard.Checked       = Not gvaSettingsBool.Item( "BASIC" )
  474. 	CheckboxMemory.Checked          = True
  475. 	CheckboxMonitor.Checked         = Not gvaSettingsBool.Item( "BASIC" )
  476. 	CheckboxMouse.Checked           = Not gvaSettingsBool.Item( "BASIC" )
  477. 	CheckboxNIC.Checked             = Not gvaSettingsBool.Item( "BASIC" )
  478. 	CheckboxPorts.Checked           = Not gvaSettingsBool.Item( "BASIC" )
  479. 	CheckboxVideo.Checked           = Not gvaSettingsBool.Item( "BASIC" )
  480. 	CheckboxSound.Checked           = Not gvaSettingsBool.Item( "BASIC" )
  481. 	If gvaSettingsBool.Item( "BASIC" ) Then
  482. 		ButtonBasic.value     = "Full"
  483. 		ButtonBasic.accessKey = "f"
  484. 	Else
  485. 		ButtonBasic.value     = "Basic"
  486. 		ButtonBasic.accessKey = "b"
  487. 	End If
  488. End Sub
  489.  
  490.  
  491. Function Chain( myCharList )
  492. 	Dim intChar, strChar, strCharChain
  493. 	Chain = ""
  494. 	If Not IsArray( myCharList ) Then
  495. 		If InStr( myCharList, ";" ) Then
  496. 			myCharList = Split( myCharList, ";" )
  497. 		ElseIf InStr( myCharList, "," ) Then
  498. 			myCharList = Split( myCharList, "," )
  499. 		Else
  500. 			Exit Function
  501. 		End If
  502. 	End If
  503. 	For Each intChar In myCharList
  504. 		If CInt( intChar ) = 0 Then
  505. 			' Uncomment next line to abort at first null character
  506. 			' Exit For
  507. 			' Comment next line when aborting at first null character
  508. 			strChar = " "
  509. 		Else
  510. 			strChar = Chr( intChar )
  511. 		End If
  512. 		strCharChain = strCharChain & strChar
  513. 	Next
  514. 	Chain = Trim( strCharChain )
  515. End Function
  516.  
  517.  
  518. Function CheckComputerName( myComputerName )
  519. 	Dim blnReady, colItems, objItem, objWMIService, strComputerName
  520. 	strComputerName = UCase( myComputerName )
  521. 	CheckComputerName = ""
  522. 	blnReady = False
  523. 	If Not gvbWinPE Then
  524. 		strComputerName = GetHostName( strComputerName )
  525. 		If strComputerName = "" Then
  526. 			MsgBox "Error while trying to ping computer " & strComputerName, vbOKOnly, "Connection Error"
  527. 			Reset
  528. 			Exit Function
  529. 		End If
  530. 	End If
  531. 	CheckComputerName = strComputerName
  532. End Function
  533.  
  534.  
  535. Sub CheckDMIDecode( )
  536. 	Dim blnFound, i
  537. 	blnFound = False
  538. 	If gvbWinPE Then Exit Sub
  539. 	For i = 0 To UBound( gvaPATH )
  540. 		With gvoFSO
  541. 			gvsDMIDecode = .BuildPath( gvaPATH(i), "dmidecode.exe" )
  542. 			If .FileExists( gvsDMIDecode ) Then
  543. 				blnFound = True
  544. 				Exit For
  545. 			End If
  546. 		End With
  547. 	Next
  548. 	gvaSettingsBool.Item( "DMIDECODE" ) = gvaSettingsBool.Item( "DMIDECODE" ) And blnFound
  549. 	CheckboxDMIDecode.disabled = Not blnFound
  550. 	DebugMessage "", "DMIDecode found: " & CStr( blnFound )
  551. End Sub
  552.  
  553.  
  554. Sub CheckKey( )
  555. 	' Backspace
  556. 	If SettingsScreen.style.display = "none" And MainScreen.style.display = "none" Then ' Not in Settings or Main screen
  557. 		If Self.window.event.keyCode =  8 Then
  558. 			ShowMain ' BackSpace => Back to main window
  559. 		End If
  560. 	End If
  561. 	' Escape
  562. 	If Self.window.event.keyCode = 27 Then
  563. 		ShowMain ' Esc => Back to main window
  564. 	End If
  565. 	' Enter
  566. 	If Not MainScreen.style.display = "none" Then ' In Main screen
  567. 		If Self.window.event.keyCode =  13 Then
  568. 			Inventory ' Enter => Start inventory
  569. 		End If
  570. 	End if
  571. 	If Self.window.event.altKey Then
  572. 		If Self.window.event.keyCode = 68 Then ' Alt+d, toggle Debug mode
  573. 			gvaSettingsBool.Item( "DEBUG" ) = Not gvaSettingsBool.Item( "DEBUG" )
  574. 			ConfigUpdateStatus
  575. 		End If
  576. 	End If
  577. End Sub
  578.  
  579.  
  580. Sub CheckUpdate( )
  581. 	Dim intAnswer, intButtons, lenLatestVer, strCurrentVer, strLatestver, strPrompt, strTitle
  582.  
  583. 	If Not gvaSettingsBool.Item( "NOUPD" ) And Not gvbWinPE Then
  584. 		' Change cursor to hourglass while checking for update
  585. 		Document.Body.style.Cursor = "wait"
  586.  
  587. 		intButtons = vbYesNoCancel + vbApplicationModal + vbInformation
  588. 		strCurrentVer = Split( Hardware.Version )(0)
  589. 		strLatestVer  = TextFromHTML( "https://www.robvanderwoude.com/updates/hardware.txt" )
  590.  
  591. 		If strCurrentVer <> strLatestver Then
  592. 			On Error Resume Next ' REQUIRED
  593. 			' Clear the IE cache
  594. 			gvoWSHShell.Run "RUNDll32.EXE InetCpl.cpl,ClearMyTracksByProcess 8", 7, True
  595. 			' Try again, read the latest version info from the web
  596. 			strLatestver = TextFromHTML( "https://www.robvanderwoude.com/updates/hardware.txt" )
  597. 			On Error Goto 0
  598. 		End If
  599.  
  600. 		DebugMessage "Check for Update", Align( "Connected to Internet:", 25 ) & gvbConnected  & vbCrLf & Align( "Current Version:", 25 ) & strCurrentVer & vbCrLf & Align( "Latest  Version:", 25 ) & strLatestver  & vbCrLf
  601.  
  602. 		If gvbConnected Then
  603. 			lenLatestVer = Len( strLatestVer )
  604. 			If lenLatestVer >= 4 And lenLatestVer <= 6 Then
  605. 				If strLatestVer < strCurrentVer Then
  606. 					strTitle  = "Unofficial version"
  607. 					strPrompt = "You seem to be using a pre-release version (" & strCurrentVer & ") of Hardware.hta." _
  608. 					          & vbCrLf & vbCrLf _
  609. 					          & "The latest official release is " & strLatestver _
  610. 					          & vbCrLf & vbCrLf _
  611. 					          & "Do you want to download the latest official release?"
  612. 					intAnswer = MsgBox( strPrompt, intButtons + vbDefaultButton2, strTitle )
  613. 					If intAnswer = vbYes Then
  614. 						gvoWSHShell.Run "https://www.robvanderwoude.com/hardware.php", 7, False
  615. 					End If
  616. 				End If
  617. 				If strLatestVer > strCurrentVer Then
  618. 					strTitle  = "Old version"
  619. 					strPrompt = "You are using version " & strCurrentVer & " of Hardware.hta." _
  620. 					          & vbCrLf & vbCrLf _
  621. 					          & "The latest official release is " & strLatestver _
  622. 					          & vbCrLf & vbCrLf _
  623. 					          & "Do you want to download the latest official release?"
  624. 					intAnswer = MsgBox( strPrompt, intButtons, strTitle )
  625. 					If intAnswer = vbYes Then
  626. 						gvoWSHShell.Run "https://www.robvanderwoude.com/hardware.php", 7, False
  627. 					End If
  628. 				End If
  629. 			Else
  630. 				strTitle  = "Update Check Failure"
  631. 				strPrompt = "Unable to check for updates." _
  632. 				          & vbCrLf & vbCrLf _
  633. 				          & "Do you want to ""manually"" check for updates now?"
  634. 				intAnswer = MsgBox( strPrompt, intButtons, strTitle )
  635. 				If intAnswer = vbYes Then
  636. 					gvoWSHShell.Run "https://www.robvanderwoude.com/hardware.php", 7, False
  637. 				End If
  638. 			End If
  639. 		End If
  640.  
  641. 		' Change cursor back to default
  642. 		Document.Body.style.Cursor = "default"
  643. 	End If
  644. End Sub
  645.  
  646.  
  647. Function CheckWinPE( )
  648. 	' Check if running in WinPE environment
  649. 	' Based on a tip by Mitch Tulloch
  650. 	' http://techgenix.com/HowtodetectwhetheryouareinWindowsPE/
  651. 	Dim arrKeys, blnWinPE, colItems, i, objItem, objReg, objWMIService
  652. 	blnWinPE = False
  653.     Set objReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!//./root/default:StdRegProv" )
  654. 	objReg.EnumKey HKEY_LOCAL_MACHINE, "SYSTEM\ControlSet001\Control", arrKeys
  655. 	For i = 0 To UBound( arrKeys )
  656. 		If UCase( arrKeys(i) ) = "MININT" Then
  657. 			blnWinPE = True
  658. 			Exit For
  659. 		End If
  660. 	Next
  661. 	Set objReg = Nothing
  662. 	If blnWinPE Then
  663. 		' Find computer name when in WinPE
  664. 		' Based on code by Richie Schuster
  665. 		' http://www.sccmog.com/get-current-old-machine-name-winpe-vbscript/
  666. 		Set objWMIService = GetObject( "winmgmts://./root/CIMV2" )
  667. 		Set colItems = objWMIService.ExecQuery ( "Select * From Win32_LogicalDisk" )
  668. 		gvsWinDrive = ""
  669. 		For Each objItem in colItems
  670. 			' Find Windows system drive (won't work if Windows folder is renamed)
  671. 			If gvoFSO.FolderExists( gvoFSO.BuildPath( objItem.DeviceID, "Windows\System32\config" ) ) Then
  672. 				gvsWinDrive = objItem.DeviceID
  673. 			End If
  674. 		Next
  675. 		Set colItems = Nothing
  676. 		If gvsWinDrive <> "" Then
  677. 			' Mount registry hive from Windows Drive
  678. 			gvoWSHShell.Run "CMD.EXE /C REG.EXE Load HKLM\TempHive " & gvsWinDrive & "\windows\system32\config\system", 0, True
  679. 			' Read computer name from mounted registry hive
  680. 			gvsComputer = wshShell.RegRead( "HKEY_LOCAL_MACHINE\TempHive\ControlSet001\Control\ComputerName\ComputerName" )
  681. 			' Unmount temporary registry hive
  682. 			gvoWSHShell.Run "CMD.EXE /C REG.EXE Unload HKLM\TempHive", 0, True
  683. 		End If
  684. 		Set objWMIService = Nothing
  685. 	End If
  686. 	CheckWinPE = blnWinPE
  687. End Function
  688.  
  689.  
  690. Sub ConfigReadCommandline( )
  691. 	Dim objRE
  692. 	Dim strDebug, strItem, strKey, strSubItem
  693. 	For Each strKey In gvaSettingsBool.Keys
  694. 		If InStr( gvsCommandlineUC, "/" & UCase( strKey ) ) Then gvaSettingsBool.Item( strKey ) = True
  695. 	Next
  696. 	strItem = GetParameter( gvsCommandline, "COMPUTER" )
  697. 	If strItem <> "" Then gvaSettingsStr.Item( "COMPUTER" ) = UCase( strItem )
  698. 	strItem = GetParameter( gvsCommandline, "SAVE" )
  699. 	If strItem <> "" Then
  700. 		With gvoFSO
  701. 			strItem = .GetAbsolutePathName( strItem )
  702. 			If .FolderExists( .GetParentFolderName( strItem ) ) Then
  703. 				gvaSettingsStr.Item( "SAVE" ) = strItem
  704. 			Else
  705. 				gvaSettingsStr.Item( "SAVE" ) = ""
  706. 			End If
  707. 		End With
  708. 	End If
  709. 	strItem = GetParameter( gvsCommandline, "TEMPDIR" )
  710. 	If strItem <> "" And gvoFSO.FolderExists( strItem ) Then
  711. 		gvaSettingsStr.Item( "TEMPDIR" ) = strItem
  712. 	End If
  713. 	strItem = GetParameter( gvsCommandline, "THEME" )
  714. 	Select Case UCase( strItem )
  715. 		Case "BW":
  716. 			gvaSettingsStr.Item( "THEME" ) = "ThemeBW"
  717. 		Case "BLUE":
  718. 			gvaSettingsStr.Item( "THEME" ) = "ThemeBlue"
  719. 		Case "CUSTOM":
  720. 			gvaSettingsStr.Item( "THEME" ) = "ThemeCustom"
  721. 		Case "DARK":
  722. 			gvaSettingsStr.Item( "THEME" ) = "ThemeDark"
  723. 		Case "DEFAULT":
  724. 			gvaSettingsStr.Item( "THEME" ) = "ThemeBW"
  725. 		Case "RED":
  726. 			gvaSettingsStr.Item( "THEME" ) = "ThemeRed"
  727. 	End Select
  728. 	strSubItem = GetParameter( gvsCommandline, "CUSTOMCOLORS" )
  729. 	If ( strItem = "" Or gvaSettingsStr.Item( "THEME" ) = "ThemeCustom" ) And strSubItem <> "" Then
  730. 		gvaSettingsStr.Item( "CUSTOMCOLORS" ) = LCase( strSubItem )
  731. 		gvaSettingsStr.Item( "THEME" )        = "ThemeCustom"
  732. 	End If
  733. 	strItem = GetParameter( gvsCommandline, "XML" )
  734. 	If strItem <> "" Then
  735. 		With gvoFSO
  736. 			strItem = .GetAbsolutePathName( strItem )
  737. 			If .FolderExists( .GetParentFolderName( strItem ) ) Then
  738. 				gvaSettingsStr.Item( "XML" ) = strItem
  739. 			End If
  740. 		End With
  741. 	End If
  742. 	strItem = GetParameter( gvsCommandline, "ZOOM" )
  743. 	If strItem <> "" Then
  744. 		If IsNumeric( strItem ) Then
  745. 			If CInt( strItem ) < 50 Then strItem = 50
  746. 			If CInt( strItem ) > 250 Then strItem = 250
  747. 			gvaSettingsStr.Item( "ZOOM" ) = CInt( strItem )
  748. 		End If
  749. 	End If
  750. 	strDebug = Align( "<u>Setting:</u>", 21 ) & "<u>Value:</u>" & vbCrLf
  751. 	For Each strKey In gvaSettingsBool.Keys
  752. 		strDebug = strDebug & Align( strKey, 14 ) & gvaSettingsBool.Item( strKey ) & vbCrLf
  753. 	Next
  754. 	For Each strKey In gvaSettingsStr.Keys
  755. 		strDebug = strDebug & Align( strKey, 14 ) & """" & gvaSettingsStr.Item( strKey ) & """" & vbCrLf
  756. 	Next
  757. 	DebugMessage "Settings After Reading Command Line", strDebug
  758. 	' Remove HTA path from command line
  759. 	Set objRE = New RegExp
  760. 	objRE.IgnoreCase = True
  761. 	objRE.Pattern = ".*?\.hta."
  762. 	If objRE.Test( gvsCommandline ) Then
  763. 		gvsCommandline = Trim( objRE.Replace( gvsCommandline, "" ) )
  764. 	End If
  765. 	DisplayCommandLine.innerHTML = gvsCommandline
  766. 	If gvaSettingsBool.item( "DEVTEST" ) Then
  767. 		' With /DEVTEST window size is 800x100, zoomfactor 75%
  768. 		gvaSettingsStr.Item( "ZOOM" ) = 75
  769. 		InputZoomFactor.value = "75"
  770. 		' Remove /DEVTEST from display
  771. 		objRE.Pattern = "/DEVTEST"
  772. 		If objRE.Test( DisplayCommandLine.innerHTML ) Then
  773. 			DisplayCommandLine.innerHTML = objRE.Replace( DisplayCommandLine.innerHTML, "" )
  774. 		End If
  775. 		objRE.Pattern = "\s+"
  776. 		DisplayCommandLine.innerHTML = objRE.Replace( DisplayCommandLine.innerHTML, " " )
  777. 	End If
  778. 	Set objRE = Nothing
  779. End Sub
  780.  
  781.  
  782. Sub ConfigReadDefaults( )
  783. 	Dim strDebug, strKey
  784. 	gvaDefaultsBool.Item( "BASIC" )       = False
  785. 	gvaDefaultsBool.Item( "CHAIN" )       = False
  786. 	gvaDefaultsBool.Item( "CM" )          = False
  787. 	gvaDefaultsBool.Item( "COPY" )        = False
  788. 	gvaDefaultsBool.Item( "DEBUG" )       = False
  789. 	gvaDefaultsBool.Item( "DEVTEST" )     = False
  790. 	gvaDefaultsBool.Item( "DMIDECODE" )   = False
  791. 	gvaDefaultsBool.Item( "DXDIAG" )      = False
  792. 	gvaDefaultsBool.Item( "KEEPXML" )     = False
  793. 	gvaDefaultsBool.Item( "NOUPD" )       = False
  794. 	gvaDefaultsBool.Item( "NOSCORES" )    = False
  795. 	gvaDefaultsBool.Item( "PRINT" )       = False
  796. 	gvaDefaultsBool.Item( "USBSTOR" )     = False
  797. 	gvaDefaultsBool.Item( "VIRTUAL" )     = False
  798. 	gvaDefaultsStr.Item( "COMPUTER" )     = GetLocalComputerName( )
  799. 	gvaDefaultsStr.Item( "CUSTOMCOLORS" ) = "white;black;blue;silver;black;black" ' Background;Captions;Links;ButtonFace;ButtonCaption;Code
  800. 	gvaSettingsStr.Item( "DEBUGLOG" )     = Left( Self.location.pathname, Len( Self.location.pathname ) - 4 ) & ".debuglog.html"
  801. 	gvaDefaultsStr.Item( "SAVE" )         = ""
  802. 	gvaDefaultsStr.Item( "TEMPDIR" )      = gvoFSO.GetAbsolutePathName( gvoWSHShell.ExpandEnvironmentStrings( "%Temp%" ) )
  803. 	gvaDefaultsStr.Item( "THEME" )        = "ThemeBW" ' ThemeBlue, ThemeBW, ThemeCustom, ThemeDark or ThemeRed
  804. 	gvaDefaultsStr.Item( "XML" )          = Left( Self.location.pathname, Len( Self.location.pathname ) - 4 ) & ".xml"
  805. 	gvaDefaultsStr.Item( "ZOOM" )         = 100
  806. 	ConfigSetDefaults
  807. 	strDebug = Align( "<u>Setting:</u>", 21 ) & "<u>Value:</u>" & vbCrLf
  808. 	For Each strKey In gvaDefaultsBool.Keys
  809. 		strDebug = strDebug & Align( strKey, 14 ) & gvaSettingsBool.Item( strKey ) & vbCrLf
  810. 	Next
  811. 	For Each strKey In gvaDefaultsStr.Keys
  812. 		strDebug = strDebug & Align( strKey, 14 ) & """" & gvaSettingsStr.Item( strKey ) & """" & vbCrLf
  813. 	Next
  814. 	DebugMessage "Settings After Reading Defaults", strDebug
  815. End Sub
  816.  
  817.  
  818. Sub ConfigReadFile( )
  819. 	Dim intMinSize, intSize
  820. 	Dim objFile, objRE
  821. 	Dim strDebug, strConfig, strItem, strKey, strSubItem, strUConfig
  822. 	If gvoFSO.FileExists( gvsConfigFile ) Then
  823. 		' Check config file size
  824. 		Set objFile = gvoFSO.GetFile( gvsConfigFile )
  825. 		intSize = objFile.Size
  826. 		Set objFile = Nothing
  827. 		' Check minimum required file size by "measuring" command line switch length
  828. 		intMinSize = 9999
  829. 		For Each strKey In gvaDefaultsBool.Keys
  830. 			intMinSize = Min( intMinSize, Len( strKey ) )
  831. 		Next
  832. 		' Add 1 for the forward slash
  833. 		intMinSize = intMinSize + 1
  834. 		' Config file is useless if its size is less than the length of the shortest command line switch
  835. 		If intSize < intMinSize Then
  836. 			gvoFSO.DeleteFile gvsConfigFile, True
  837. 		Else
  838. 			' Read the entire contents of the configuration file
  839. 			Set objFile = gvoFSO.OpenTextFile( gvsConfigFile, ForReading, False, TristateFalse )
  840. 			strConfig  = Trim( Replace( objFile.ReadAll( ), vbCrLf, " " ) )
  841. 			strUConfig = UCase( strConfig )
  842. 			objFile.Close
  843. 			Set objFile = Nothing
  844. 			' Replace all whitespace (space, tab, linefeed, carriage return, or any combination) by single spaces
  845. 			DisplayConfig.innerHTML = Join( Split( strConfig, vbCrLf ), " " )
  846. 			DisplayConfig.innerHTML = Join( Split( DisplayConfig.innerHTML, vbCr ), " " )
  847. 			DisplayConfig.innerHTML = Join( Split( DisplayConfig.innerHTML, vbLf ), " " )
  848. 			DisplayConfig.innerHTML = Trim( Join( Split( DisplayConfig.innerHTML, vbTab ), " " ) )
  849. 			' Remove /DEVTEST from display
  850. 			Set objRE = New RegExp
  851. 			objRE.Pattern = "/DEVTEST"
  852. 			objRE.IgnoreCase = True
  853. 			If objRE.Test( DisplayConfig.innerHTML ) Then
  854. 				DisplayConfig.innerHTML = objRE.Replace( DisplayConfig.innerHTML, "" )
  855. 			End If
  856. 			Set objRE  = Nothing
  857. 			For Each strKey In gvaSettingsBool.Keys
  858. 				If InStr( strUConfig, "/" & strKey ) Then gvaSettingsBool.Item( strKey ) = True
  859. 			Next
  860. 			strItem = GetParameter( strConfig, "THEME" )
  861. 			Select Case UCase( strItem )
  862. 				Case "BLUE":
  863. 					gvaSettingsStr.Item( "THEME" ) = "ThemeBlue"
  864. 				Case "BW":
  865. 					gvaSettingsStr.Item( "THEME" ) = "ThemeBW"
  866. 				Case "CUSTOM":
  867. 					gvaSettingsStr.Item( "THEME" ) = "ThemeCustom"
  868. 				Case "DARK":
  869. 					gvaSettingsStr.Item( "THEME" ) = "ThemeDark"
  870. 				Case "":
  871. 				Case "DEFAULT":
  872. 					gvaSettingsStr.Item( "THEME" ) = "ThemeBW"
  873. 				Case "RED":
  874. 					gvaSettingsStr.Item( "THEME" ) = "ThemeRed"
  875. 			End Select
  876. 			strSubItem = GetParameter( strConfig, "CUSTOMCOLORS" )
  877. 			If ( strItem = "" Or gvaSettingsStr.Item( "THEME" ) = "ThemeCustom" ) And strSubItem <> "" Then
  878. 				gvaSettingsStr.Item( "CUSTOMCOLORS" ) = LCase( strSubItem )
  879. 				gvaSettingsStr.Item( "THEME" )        = "ThemeCustom"
  880. 			End If
  881. 			strItem = GetParameter( strConfig, "XML" )
  882. 			If strItem <> "" Then
  883. 				With gvoFSO
  884. 					If .FolderExists( .GetParentFolderName( .GetAbsolutePathName( strItem ) ) ) Then
  885. 							gvaSettingsStr.Item( "XML" ) = .GetAbsolutePathName( strItem )
  886. 					End If
  887. 				End With
  888. 			End If
  889. 			strItem = GetParameter( strConfig, "ZOOM" )
  890. 			If strItem <> "" Then
  891. 				If IsNumeric( strItem ) Then
  892. 					If CInt( strItem ) < 50 Then strItem = 50
  893. 					If CInt( strItem ) > 250 Then strItem = 250
  894. 					gvaSettingsStr.Item( "ZOOM" ) = CInt( strItem )
  895. 				End If
  896. 			End If
  897. 		End If
  898. 	End If
  899. 	strDebug = Align( "<u>Setting:</u>", 21 ) & "<u>Value:</u>" & vbCrLf
  900. 	For Each strKey In gvaDefaultsBool.Keys
  901. 		strDebug = strDebug & Align( strKey, 14 ) & gvaSettingsBool.Item( strKey ) & vbCrLf
  902. 	Next
  903. 	For Each strKey In gvaDefaultsStr.Keys
  904. 		strDebug = strDebug & Align( strKey, 14 ) & """" & gvaSettingsStr.Item( strKey ) & """" & vbCrLf
  905. 	Next
  906. 	If gvaSettingsBool.Item( "DEBUG" ) And gvoFSO.FileExists( gvaSettingsStr.Item( "DEBUGLOG" ) ) Then gvoFSO.DeleteFile gvaSettingsStr.Item( "DEBUGLOG" ), True
  907. 	DebugMessage "Settings After Reading " & gvsConfigFile, strDebug
  908. End Sub
  909.  
  910.  
  911. Sub ConfigRemoveFile( )
  912. 	If gvoFSO.FileExists( gvsConfigFile ) Then gvoFSO.DeleteFile gvsConfigFile, True
  913. End Sub
  914.  
  915.  
  916. Sub ConfigReset( )
  917. 	ConfigRemoveFile
  918. 	DisplayConfig.innerHTML = ""
  919. 	ButtonEditCfg.disabled  = True
  920. 	ButtonReset.disabled    = True
  921. 	InputZoomFactor.value   = gvaDefaultsStr.Item( "ZOOM" )
  922. 	ConfigSetDefaults
  923. 	ConfigUpdateStatus
  924. End Sub
  925.  
  926.  
  927. Sub ConfigSaveChanges( )
  928. 	Dim objItem, objOption, strCustomColors, strDebug, strKey
  929. 	With gvoFSO
  930. 		If Not IsEmpty( InputDxDiag.value ) Then
  931. 			If .FolderExists( .GetParentFolderName( InputDxDiag.value ) ) Then
  932. 					InputDxDiag.value = .GetAbsolutePathName( InputDxDiag.value )
  933. 				End If
  934. 		End If
  935. 		If Not IsEmpty( InputDebugLogPath.value ) Then
  936. 			If .FolderExists( .GetParentFolderName( InputDebugLogPath.value ) ) Then
  937. 				InputDebugLogPath.value = .GetAbsolutePathName( InputDebugLogPath.value )
  938. 			End If
  939. 		End If
  940. 	End With
  941. 	gvaSettingsBool.Item( "CM" )        = CheckboxCM.checked
  942. 	gvaSettingsBool.Item( "CHAIN" )     = CheckboxCharacterChains.checked
  943. 	gvaSettingsBool.Item( "DEBUG" )     = CheckboxDebugMode.checked
  944. 	gvaSettingsBool.Item( "DMIDECODE" ) = CheckboxDMIDecode.checked
  945. 	gvaSettingsBool.Item( "DXDIAG" )    = CheckboxDxDiag.checked
  946. 	gvaSettingsBool.Item( "KEEPXML" )   = CheckboxKeepXML.checked
  947. 	gvaSettingsBool.Item( "NOUPD" )     = Not CheckboxCheckUpd.checked
  948. 	gvaSettingsBool.Item( "NOSCORES" )  = Not CheckboxScores.checked
  949. 	gvaSettingsBool.Item( "USBSTOR" )   = CheckboxUSBSTOR.checked
  950. 	gvaSettingsBool.Item( "VIRTUAL" )   = CheckboxVirtual.checked
  951. 	If gvaSettingsStr.Item( "XML" ) <> "" Then
  952. 		If InputDxDiag.value <> "" Then
  953. 			gvaSettingsStr.Item( "XML" ) = gvaDefaultsStr.Item( "XML" )
  954. 		Else
  955. 			gvaSettingsStr.Item( "XML" ) = InputDxDiag.value
  956. 		End If
  957. 	End If
  958. 	If InputDebugLogPath.value = "" Then
  959. 		gvaSettingsStr.Item( "DEBUGLOG" ) = gvaDefaultsStr.Item( "DEBUGLOG" )
  960. 	Else
  961. 		gvaSettingsStr.Item( "DEBUGLOG" ) = InputDebugLogPath.value
  962. 	End If
  963. 	If ThemeBlue.checked Then
  964. 		gvaSettingsStr.Item( "THEME" )        = "ThemeBlue"
  965. 		gvaSettingsStr.Item( "CUSTOMCOLORS" ) = "darkblue;white;red;silver;black;yellow"
  966. 	ElseIf ThemeDark.checked Then
  967. 		gvaSettingsStr.Item( "THEME" )        = "ThemeDark"
  968. 		gvaSettingsStr.Item( "CUSTOMCOLORS" ) = "black;white;gold;slategray;snow;red"
  969. 	ElseIf ThemeBW.checked Then
  970. 		gvaSettingsStr.Item( "THEME" )        = "ThemeBW"
  971. 		gvaSettingsStr.Item( "CUSTOMCOLORS" ) = gvaDefaultsStr.Item( "CUSTOMCOLORS" )
  972. 	ElseIf ThemeRed.checked Then
  973. 		gvaSettingsStr.Item( "THEME" )        = "ThemeRed"
  974. 		gvaSettingsStr.Item( "CUSTOMCOLORS" ) = "red;yellow;darkblue;silver;black;white"
  975. 	ElseIf ThemeCustom.checked Then
  976. 		For Each objOption In BackgroundColor.options
  977. 			If objOption.selected Then strCustomColors = objOption.value
  978. 		Next
  979. 		For Each objOption In CaptionsColor.options
  980. 			If objOption.selected Then strCustomColors = strCustomColors & ";" & objOption.value
  981. 		Next
  982. 		For Each objOption In LinksColor.options
  983. 			If objOption.selected Then strCustomColors = strCustomColors & ";" & objOption.value
  984. 		Next
  985. 		For Each objOption In ButtonFaceColor.options
  986. 			If objOption.selected Then strCustomColors = strCustomColors & ";" & objOption.value
  987. 		Next
  988. 		For Each objOption In ButtonCaptionsColor.options
  989. 			If objOption.selected Then strCustomColors = strCustomColors & ";" & objOption.value
  990. 		Next
  991. 		For Each objOption In CodeColor.options
  992. 			If objOption.selected Then strCustomColors = strCustomColors & ";" & objOption.value
  993. 		Next
  994. 		gvaSettingsStr.Item( "THEME" )        = "ThemeCustom"
  995. 		gvaSettingsStr.Item( "CUSTOMCOLORS" ) = LCase( strCustomColors )
  996. 	End If
  997. 	If Not InputZoomFactor.value = gvaSettingsStr.Item( "ZOOM" ) Then
  998. 		If IsEmpty( InputZoomFactor.value ) Then
  999. 			InputZoomFactor.value = 100
  1000. 		Else
  1001. 			InputZoomFactor.value = Min( 250, Max( 50, InputZoomFactor.value ) )
  1002. 		End If
  1003. 		gvaSettingsStr.Item( "ZOOM" ) = InputZoomFactor.value
  1004. 		document.body.style.zoom = gvaSettingsStr.Item( "ZOOM" ) & "%"
  1005. 	End If
  1006. 	If ConfigTestIfDefault( ) Then
  1007. 		If gvoFSO.FileExists( gvsConfigFile ) Then
  1008. 			strDebug = "Deleting config file"
  1009. 			gvoFSO.DeleteFile gvsConfigFile, True
  1010. 		End If
  1011. 		DebugMessage "Save settings was clicked, but all settings are default", strDebug
  1012. 		ButtonReset.disabled = True
  1013. 	Else
  1014. 		strDebug = Align( "<u>Setting:</u>", 21 ) & "<u>Value:</u>" & vbCrLf
  1015. 		For Each strKey In gvaSettingsBool.Keys
  1016. 			strDebug = strDebug & Align( strKey, 14 ) & gvaSettingsBool.Item( strKey ) & vbCrLf
  1017. 		Next
  1018. 		For Each strKey In gvaSettingsStr.Keys
  1019. 			strDebug = strDebug & Align( strKey, 14 ) & """" & gvaSettingsStr.Item( strKey ) & """" & vbCrLf
  1020. 		Next
  1021. 		DebugMessage "Settings After Saving Changes", strDebug
  1022. 	End If
  1023. End Sub
  1024.  
  1025.  
  1026. Sub ConfigSaveFile( )
  1027. 	Dim objFile
  1028. 	dim strConfig, strKey
  1029. 	If ConfigTestIfDefault( ) Then
  1030. 		If gvoFSO.FileExists( gvsConfigFile ) Then
  1031. 			gvoFSO.DeleteFile gvsConfigFile, True
  1032. 			MsgBox "Since all settings are back to their default values, """ & gvsConfigFile & """ has been deleted", vbOKOnly, "Save Settings"
  1033. 		Else
  1034. 			MsgBox "Since all settings have their default values, nothing was saved", vbOKOnly, "Save Settings"
  1035. 		End If
  1036. 	Else
  1037. 		strConfig = ""
  1038. 		For Each strKey In gvaSettingsBool.Keys
  1039. 			If gvaSettingsBool.Item( strKey ) Then
  1040. 				strConfig = strConfig & " /" & strKey
  1041. 			End If
  1042. 		Next
  1043. 		If gvaSettingsBool.Item( "DXDIAG" ) And ( gvaSettingsStr.Item( "XML" ) <> "" ) Then
  1044. 			strConfig = strConfig & " /XML:" & gvaSettingsStr.Item( "XML" )
  1045. 		End If
  1046. 		If gvaSettingsStr.Item( "COMPUTER" ) <> "" Then
  1047. 			If UCase( gvaSettingsStr.Item( "COMPUTER" ) ) <> UCase( GetLocalComputerName ) Then
  1048. 				strConfig = strConfig & " /COMPUTER:" & UCase( gvaSettingsStr.Item( "COMPUTER" ) )
  1049. 			End If
  1050. 		End If
  1051. 		If gvaSettingsStr.Item( "THEME" ) <> "" And gvaSettingsStr.Item( "THEME" ) <> "ThemeBW" Then
  1052. 			strConfig = strConfig & " /THEME:" & Mid( gvaSettingsStr.Item( "THEME" ), 6 )
  1053. 			If gvaSettingsStr.Item( "THEME" ) = "ThemeCustom" Then
  1054. 				If gvaSettingsStr.Item( "CUSTOMCOLORS" ) <> "" Then
  1055. 					strConfig = Trim( strConfig & " /CUSTOMCOLORS:" & LCase( gvaSettingsStr.Item( "CUSTOMCOLORS" ) ) )
  1056. 				End If
  1057. 			End If
  1058. 		End If
  1059. 		If Not CInt( gvaSettingsStr.Item( "ZOOM" ) ) = 100 Then
  1060. 			strConfig = strConfig & " /ZOOM:" & gvaSettingsStr.Item( "ZOOM" )
  1061. 		End If
  1062. 		Set objFile = gvoFSO.OpenTextFile( gvsConfigFile, ForWriting, True, TristateFalse )
  1063. 		objFile.Write strConfig
  1064. 		objFile.Close
  1065. 		Set objFile = Nothing
  1066. 		DisplayConfig.innerHTML = strConfig
  1067. 		MsgBox "The new settings have been saved in """ & gvsConfigFile & """", vbOKOnly + vbInformation + vbApplicationModal, "Settings saved"
  1068. 		DebugMessage "Saving Settings to " & gvsConfigFile, strConfig
  1069. 	End If
  1070. End Sub
  1071.  
  1072.  
  1073. Sub ConfigSetDefaults( )
  1074. 		Dim strKey
  1075. 		For Each strKey In gvaDefaultsBool.Keys
  1076. 			gvaSettingsBool.Item( strKey ) = gvaDefaultsBool.Item( strKey )
  1077. 		Next
  1078. 		For Each strKey In gvaDefaultsStr.Keys
  1079. 			gvaSettingsStr.Item( strKey ) = gvaDefaultsStr.Item( strKey )
  1080. 		Next
  1081. End Sub
  1082.  
  1083.  
  1084. Function ConfigTestIfDefault( )
  1085. 	Dim blnStart, objChkBx, strTest
  1086. 	' In debug mode (best set on the command line), show a MessageBox with checkbox settings vs defaults
  1087. 	If gvaSettingsBool.Item( "DEBUG" ) Or ( InStr( gvsCommandlineUC, "/DEBUG" ) > 0 ) Then
  1088. 		blnStart = False
  1089. 		strTest = Align( "CHECKBOX", 23 ) & vbTab & Align( "CHECKED", 7 ) & vbTab & "BY DEFAULT" & vbCrLf _
  1090. 		        & Align( "=======",  23 ) & vbTab & Align( "======",  7 ) & vbTab & "========"   & vbCrLf & vbCrLf
  1091. 		For Each objChkBx In document.getElementsByTagName( "input" )
  1092. 			If objChkBx.type = "checkbox" Then
  1093. 				If InStr( objChkBx.id, "DMIDecode" ) > 0 Then
  1094. 					blnStart = True
  1095. 				End If
  1096. 				If blnStart Then
  1097. 					strTest = strTest & Align( objChkBx.id, 23 ) & vbTab & Align( objChkBx.checked, 20 ) & vbTab
  1098. 					If objChkBx.id = "CheckboxCM"              Then strTest = strTest & gvaDefaultsBool.Item( "CM" )
  1099. 					If objChkBx.id = "CheckboxCharacterChains" Then strTest = strTest & gvaDefaultsBool.Item( "CHAIN" )
  1100. 					If objChkBx.id = "CheckboxDebugMode"       Then strTest = strTest & gvaDefaultsBool.Item( "DEBUG" )
  1101. 					If objChkBx.id = "CheckboxDMIDecode"       Then strTest = strTest & gvaDefaultsBool.Item( "DMIDECODE" )
  1102. 					If objChkBx.id = "CheckboxDxDiag"          Then strTest = strTest & gvaDefaultsBool.Item( "DXDIAG" )
  1103. 					If objChkBx.id = "CheckboxKeepXML"         Then strTest = strTest & gvaDefaultsBool.Item( "KEEPXML" )
  1104. 					If objChkBx.id = "CheckboxCheckUpd"        Then strTest = strTest & Not gvaDefaultsBool.Item( "NOUPD" )
  1105. 					If objChkBx.id = "CheckboxScores"          Then strTest = strTest & Not gvaDefaultsBool.Item( "NOSCORES" )
  1106. 					If objChkBx.id = "CheckboxUSBSTOR"         Then strTest = strTest & gvaDefaultsBool.Item( "USBSTOR" )
  1107. 					If objChkBx.id = "CheckboxVirtual"         Then strTest = strTest & gvaDefaultsBool.Item( "VIRTUAL" )
  1108. 					strTest = strTest & vbCrLf
  1109. 				End If
  1110. 			End if
  1111. 		Next
  1112. 		MsgBox strTest, vbOKOnly, "Debugging Info for ConfigTestIfDefault( )"
  1113. 	End If ' end of debugging code
  1114.  
  1115. 	' Check all checkboxes in Settings screen and compare with defaults
  1116. 	If Not ( CheckboxCM.checked = gvaSettingsBool.Item( "CM" ) ) Then
  1117. 		ConfigTestIfDefault = False
  1118. 		Exit Function
  1119. 	End If
  1120. 	If Not ( CheckboxCharacterChains.checked = gvaDefaultsBool.Item( "CHAIN" ) ) Then
  1121. 		ConfigTestIfDefault = False
  1122. 		Exit Function
  1123. 	End If
  1124. 	If Not ( CheckboxDebugMode.checked = gvaDefaultsBool.Item( "DEBUG" ) ) Then
  1125. 		ConfigTestIfDefault = False
  1126. 		Exit Function
  1127. 	End If
  1128. 	If Not ( CheckboxDMIDecode.checked = gvaDefaultsBool.Item( "DMIDECODE" ) ) Then
  1129. 		ConfigTestIfDefault = False
  1130. 		Exit Function
  1131. 	End If
  1132. 	If Not ( CheckboxDxDiag.checked = gvaDefaultsBool.Item( "DXDIAG" ) ) Then
  1133. 		ConfigTestIfDefault = False
  1134. 		Exit Function
  1135. 	End If
  1136. 	If Not ( CheckboxKeepXML.checked = gvaDefaultsBool.Item( "KEEPXML" ) ) Then
  1137. 		ConfigTestIfDefault = False
  1138. 		Exit Function
  1139. 	End If
  1140. 	If ( CheckboxCheckUpd.checked = gvaDefaultsBool.Item( "NOUPD" ) ) Then
  1141. 		ConfigTestIfDefault = False
  1142. 		Exit Function
  1143. 	End If
  1144. 	If ( CheckboxScores.checked = gvaDefaultsBool.Item( "NOSCORES" ) ) Then
  1145. 		ConfigTestIfDefault = False
  1146. 		Exit Function
  1147. 	End If
  1148. 	If Not ( CheckboxUSBSTOR.checked = gvaDefaultsBool.Item( "USBSTOR" ) ) Then
  1149. 		ConfigTestIfDefault = False
  1150. 		Exit Function
  1151. 	End If
  1152. 	If Not ( CheckboxVirtual.checked = gvaDefaultsBool.Item( "VIRTUAL" ) ) Then
  1153. 		ConfigTestIfDefault = False
  1154. 		Exit Function
  1155. 	End If
  1156. 	If gvaSettingsStr.Item( "THEME" ) = "" Then
  1157. 		gvaSettingsStr.Item( "THEME" )        = gvaDefaultsStr.Item( "THEME" )
  1158. 		gvaSettingsStr.Item( "CUSTOMCOLORS" ) = gvaDefaultsStr.Item( "CUSTOMCOLORS" )
  1159. 		document.getElementById( gvaDefaultsStr.Item( "THEME" ) ).checked = True
  1160. 	End If
  1161. 	If ThemeCustom.checked Or ThemeBlue.checked Or ThemeDark.checked Or ThemeRed.checked Then
  1162. 		ConfigTestIfDefault = False
  1163. 		Exit Function
  1164. 	End If
  1165. 	ConfigTestIfDefault = True
  1166. End Function
  1167.  
  1168.  
  1169. Sub ConfigUpdateStatus( )
  1170. 	Dim arrCustomColors, colElements, objElement, objOption
  1171. 	If gvaSettingsBool.Item( "BASIC" ) Then
  1172. 		ButtonBasic.value     = "Full"
  1173. 		ButtonBasic.accessKey = "f"
  1174. 	Else
  1175. 		ButtonBasic.value     = "Basic"
  1176. 		ButtonBasic.accessKey = "b"
  1177. 	End If
  1178. 	ButtonDeleteXML.disabled        = Not gvoFSO.FileExists( gvaSettingsStr.Item( "XML" ) )
  1179. 	CheckboxCM.checked              = gvaSettingsBool.Item( "CM" )
  1180. 	CheckboxCharacterChains.checked = gvaSettingsBool.Item( "CHAIN" )
  1181. 	CheckboxDebugMode.checked       = gvaSettingsBool.Item( "DEBUG" )
  1182. 	CheckDMIDecode
  1183. 	CheckboxDMIDecode.checked       = gvaSettingsBool.Item( "DMIDECODE" )
  1184. 	CheckboxDMIDecode.disabled      = gvbWinPE
  1185. 	CheckboxDxDiag.checked          = gvaSettingsBool.Item( "DXDIAG" ) And Not gvbWinPE
  1186. 	CheckboxDxDiag.disabled         = gvbWinPE
  1187. 	CheckboxKeepXML.checked         = gvaSettingsBool.Item( "KEEPXML" ) And gvaSettingsBool.Item( "DXDIAG" ) And Not gvbWinPE
  1188. 	CheckboxKeepXML.disabled        = gvbWinPE
  1189. 	CheckboxCheckUpd.checked        = Not gvaSettingsBool.Item( "NOUPD" )
  1190. 	CheckboxScores.checked          = Not gvaSettingsBool.Item( "NOSCORES" )
  1191. 	CheckboxUSBSTOR.checked         = gvaSettingsBool.Item( "USBSTOR" )
  1192. 	CheckboxVirtual.checked         = gvaSettingsBool.Item( "VIRTUAL" )
  1193. 	ComputerName.value              = gvaSettingsStr.Item( "COMPUTER" )
  1194. 	InputDxDiag.value               = gvaSettingsStr.Item( "XML" )
  1195. 	InputDxDiag.readonly            = Not CheckboxDxDiag.checked Or gvbWinPE
  1196. 	InputDebugLogPath.value         = gvaSettingsStr.Item( "DEBUGLOG" )
  1197. 	InputDebugLogPath.disabled      = Not gvaSettingsBool.Item( "DEBUG" )
  1198. 	If gvaSettingsStr.Item( "THEME" ) = "" Then
  1199. 		ThemeBW.checked = True
  1200. 	Else
  1201. 		document.getElementById( gvaSettingsStr.Item( "THEME" ) ).checked = True
  1202. 	End If
  1203. 	If ThemeCustom.checked Then
  1204. 		arrCustomColors = Split( gvaSettingsStr.Item( "CUSTOMCOLORS" ), ";" )
  1205. 		For Each objOption In BackgroundColor.options
  1206. 			objOption.selected = ( objOption.value = arrCustomColors(0) )
  1207. 		Next
  1208. 		For Each objOption In CaptionsColor.options
  1209. 			objOption.selected = ( objOption.value = arrCustomColors(1) )
  1210. 		Next
  1211. 		For Each objOption In LinksColor.options
  1212. 			objOption.selected = ( objOption.value = arrCustomColors(2) )
  1213. 		Next
  1214. 		For Each objOption In ButtonFaceColor.options
  1215. 			objOption.selected = ( objOption.value = arrCustomColors(3) )
  1216. 		Next
  1217. 		For Each objOption In ButtonCaptionsColor.options
  1218. 			objOption.selected = ( objOption.value = arrCustomColors(4) )
  1219. 		Next
  1220. 		For Each objOption In CodeColor.options
  1221. 			objOption.selected = ( objOption.value = arrCustomColors(5) )
  1222. 		Next
  1223. 	ElseIf ThemeBlue.checked Then
  1224. 		gvaSettingsStr.Item( "CUSTOMCOLORS" ) = "darkblue;white;red;silver;black;yellow"
  1225. 		arrCustomColors                       = Split( gvaSettingsStr.Item( "CUSTOMCOLORS" ), ";" )
  1226. 	ElseIf ThemeDark.checked Then
  1227. 		gvaSettingsStr.Item( "CUSTOMCOLORS" ) = "black;white;gold;slategray;snow;red"
  1228. 		arrCustomColors                       = Split( gvaSettingsStr.Item( "CUSTOMCOLORS" ), ";" )
  1229. 	ElseIf ThemeRed.checked Then
  1230. 		gvaSettingsStr.Item( "CUSTOMCOLORS" ) = "red;yellow;darkblue;silver;black;white"
  1231. 		arrCustomColors                       = Split( gvaSettingsStr.Item( "CUSTOMCOLORS" ), ";" )
  1232. 	Else
  1233. 		gvaSettingsStr.Item( "CUSTOMCOLORS" ) = gvaDefaultsStr.Item( "CUSTOMCOLORS" )
  1234. 		arrCustomColors                       = Split( gvaSettingsStr.Item( "CUSTOMCOLORS" ), ";" )
  1235. 	End If
  1236. 	ListColors     "BackgroundColor",     arrCustomColors(0)
  1237. 	ListColors     "CaptionsColor",       arrCustomColors(1)
  1238. 	ListColors     "LinksColor",          arrCustomColors(2)
  1239. 	ListColors     "ButtonFaceColor",     arrCustomColors(3)
  1240. 	ListColors     "ButtonCaptionsColor", arrCustomColors(4)
  1241. 	ListColors     "CodeColor",           arrCustomColors(5)
  1242. 	SetCustomColor "BackgroundColor"
  1243. 	SetCustomColor "CaptionsColor"
  1244. 	SetCustomColor "LinksColor"
  1245. 	SetCustomColor "ButtonFaceColor"
  1246. 	SetCustomColor "ButtonCaptionsColor"
  1247. 	SetCustomColor "CodeColor"
  1248. 	document.body.style.zoom = gvaSettingsStr.Item( "ZOOM" ) & "%"
  1249. 	EnableWinSATScores
  1250. End Sub
  1251.  
  1252.  
  1253. Sub CopyToClipboard
  1254. 	On Error Resume Next ' REQUIRED
  1255. 	Document.parentWindow.clipboardData.setData "text", gvsHeader & vbCrLf & gvsCSVTxt & vbCrLf
  1256. 	If Err Then
  1257. 		MsgBox "An error occurred while trying to copy data to the clipboard:" & vbCrLf & vbCrLf & Err.Description, vbOKOnly, "Clipboard Error"
  1258. 	End If
  1259. 	On Error Goto 0
  1260. End Sub
  1261.  
  1262.  
  1263. Sub CreateDebugLogFile( )
  1264. 	Dim objDebugLog, strHTML
  1265. 	' Header for new debugging log file; note the "refresh" meta tag, allowing dynamic updates of the displayed log
  1266. 	strHTML = "<!DOCTYPE html>" & vbCrLf _
  1267. 	        & "<html lang=""en"">" _
  1268. 	        & vbCrLf _
  1269. 	        & "<head>" _
  1270. 	        & vbCrLf _
  1271. 	        & "<title>Basic Hardware Inventory Debugging Log " & gvsComputer & "</title>" _
  1272. 	        & vbCrLf _
  1273. 	        & "<meta http-equiv=""refresh"" content=""5"">" _
  1274. 	        & vbCrLf _
  1275. 	        & "</head>" _
  1276. 	        & vbCrLf _
  1277. 	        & "<body>" _
  1278. 	        & vbCrLf _
  1279. 	        & "<pre>" _
  1280. 	        & vbCrLf
  1281. 	' Create the new debugging log file, then close it
  1282. 	Set objDebugLog = gvoFSO.OpenTextFile( gvaSettingsStr.Item( "DEBUGLOG" ), ForWriting, True )
  1283. 	objDebugLog.Write strHTML
  1284. 	objDebugLog.Close
  1285. 	Set objDebugLog = Nothing
  1286. 	' Open the new debugging log file in the default browser (requires .html log file extension)
  1287. 	gvoWSHShell.Run gvaSettingsStr.Item( "DEBUGLOG" ), 7, False
  1288. End Sub
  1289.  
  1290.  
  1291. Function CreateLine( strProperty )
  1292. 	' This subroutine will split up a string into separate words:
  1293. 	' "SCSILogicalUnit" will be converted to "SCSI Logical Unit"
  1294. 	Dim chrA, chrB, chrC
  1295. 	Dim i, j, k
  1296. 	Dim strCaps, strLowc, strPropDescr
  1297.  
  1298. 	strPropDescr = strProperty
  1299. 	strCaps      = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  1300. 	strLowc      = LCase( strCaps )
  1301. 	' Default value, in case something goes wrong
  1302. 	CreateLine   = strProperty
  1303. 	i = 0
  1304. 	Do
  1305. 		i = i + 1
  1306. 		j = i + 1
  1307. 		If j >= Len( strPropDescr ) Then Exit Do
  1308. 		chrA = Mid( strPropDescr, i, 1 )
  1309. 		chrB = Mid( strPropDescr, j, 1 )
  1310. 		If InStr( strLowc, chrA ) > 0 And InStr( strCaps, chrB ) > 0 Then
  1311. 			strPropDescr = Left( strPropDescr, i ) & " " & Mid( strPropDescr, j )
  1312. 			i = i + 2
  1313. 			j = i + 1
  1314. 		End If
  1315. 	Loop
  1316. 	If Len( strPropDescr ) > 2 Then
  1317. 		i = 0
  1318. 		Do
  1319. 			i = i + 1
  1320. 			j = i + 1
  1321. 			k = i + 2
  1322. 			If k >= Len( strPropDescr ) Then Exit Do
  1323. 			chrA = Mid( strPropDescr, i, 1 )
  1324. 			chrB = Mid( strPropDescr, j, 1 )
  1325. 			chrC = Mid( strPropDescr, k, 1 )
  1326. 			If InStr( strCaps, chrA ) > 0 And InStr( strCaps, chrB ) > 0 And InStr( strLowc, chrC ) > 0 Then
  1327. 				strPropDescr = Left( strPropDescr, i ) & " " & Mid( strPropDescr, j )
  1328. 				i = i + 3
  1329. 				j = i + 1
  1330. 				k = i + 2
  1331. 			End If
  1332. 		Loop
  1333. 	End If
  1334. 	CreateLine = strPropDescr
  1335. End Function
  1336.  
  1337.  
  1338. Sub DebugMessage( myTitle, myMessage )
  1339. 	' If Debug Logging is enabled, create or open a debug log file, and append a debugging message
  1340. 	Dim objDebugLog, objRE, strDebugText
  1341. 	On Error Resume Next ' REQUIRED
  1342. 	If gvaSettingsBool.Item( "DEBUG" ) Then
  1343. 		If gvoFSO.FileExists( gvaSettingsStr.Item( "DEBUGLOG" ) ) Then
  1344. 			' Open existing log file and remove closing tags at the end of the HTML content
  1345. 			Set objDebugLog = gvoFSO.OpenTextFile( gvaSettingsStr.Item( "DEBUGLOG" ) )
  1346. 			strDebugText = objDebugLog.ReadAll( )
  1347. 			objDebugLog.Close
  1348. 			Set objRE = New RegExp
  1349. 			objRE.Global     = True
  1350. 			objRE.IgnoreCase = True
  1351. 			objRE.Pattern    = "</pre>\s*</body>\s*</html>\s*$"
  1352. 			Set objDebugLog = gvoFSO.OpenTextFile( gvaSettingsStr.Item( "DEBUGLOG" ), ForWriting, True )
  1353. 			objDebugLog.Write objRE.Replace( strDebugText, "" )
  1354. 			objDebugLog.Close
  1355. 			Set objDebugLog = Nothing
  1356. 		Else
  1357. 			' Create a new debugging log file and open it in the default browser
  1358. 			CreateDebugLogFile
  1359. 		End If
  1360. 		' Append debugging message to log file
  1361. 		Set objDebugLog = gvoFSO.OpenTextFile( gvaSettingsStr.Item( "DEBUGLOG" ), ForAppending, True )
  1362. 		If ( Trim( myTitle ) = "" ) Then
  1363. 			objDebugLog.WriteLine "[" & TimeStamp( ) & "] " & myMessage
  1364. 		Else
  1365. 			objDebugLog.WriteLine "[" & TimeStamp( ) & "] " & myTitle & vbCrLf & String( Len( myTitle ), "-" ) & vbCrLf & myMessage
  1366. 		End If
  1367. 		' Append closing tags at the end of the HTML content
  1368. 		objDebugLog.WriteLine vbCrLf & vbCrLf & "</pre>" & vbCrLf & "</body>" & vbCrLf & "</html>"
  1369. 		' Close the log file
  1370. 		objDebugLog.Close
  1371. 		Set objDebugLog = Nothing
  1372. 	End If
  1373. 	On Error GoTo 0
  1374. End Sub
  1375.  
  1376.  
  1377. Sub DeleteDxDiagXML( )
  1378. 	If InputDxDiag.value <> "" Then
  1379. 		On Error Resume Next ' REQUIRED
  1380. 		If gvoFSO.FileExists( InputDxDiag.value ) Then
  1381. 			gvoFSO.DeleteFile InputDxDiag.value, True
  1382. 		End If
  1383. 		If Err Then
  1384. 			MsgBox "Error while trying to delete the existing DxDiag XML file" & vbCrLf & """" & InputDxDiag.value & """", vbOKOnly + vbExclamation + vbApplicationModal, "File Delete Error"
  1385. 			Err.Clear
  1386. 		End If
  1387. 		On Error Goto 0
  1388. 	End If
  1389. 	ButtonDeleteXML.disabled = True
  1390. End Sub
  1391.  
  1392.  
  1393. Sub DetailsBIOS( )
  1394. 	gvsDetails = HandleClass( "Win32_BIOS", "root/CIMV2" )
  1395. 	If gvaSettingsBool.Item( "DXDIAG" ) Then
  1396. 		gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleXMLValue( "/DxDiag/SystemInformation/BIOS" )
  1397. 	End If
  1398. 	If gvaSettingsBool.Item( "DMIDECODE" ) Then
  1399. 		gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleDMIDetails( "BIOS" )
  1400. 	End If
  1401. 	DetailsWindow "BIOS", gvsDetails
  1402. End Sub
  1403.  
  1404.  
  1405. Sub DetailsCDROM( )
  1406. 	gvsDetails = HandleClass( "Win32_CDROMDrive",           "root/CIMV2" ) & vbCrLf & vbCrLf _
  1407. 	           & HandleClass( "Win32_IDEController",        "root/CIMV2" ) & vbCrLf & vbCrLf _
  1408. 	           & HandleClass( "Win32_SCSIController",       "root/CIMV2" ) & vbCrLf & vbCrLf _
  1409. 	           & HandleClass( "Win32_IDEControllerDevice",  "root/CIMV2" ) & vbCrLf & vbCrLf _
  1410. 	           & HandleClass( "Win32_SCSIControllerDevice", "root/CIMV2" )
  1411. 	If gvaSettingsBool.Item( "DXDIAG" ) Then
  1412. 		gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleXMLNode( "/DxDiag/LogicalDisks/LogicalDisk[HardDriveIndex = 0 and FileSystem <= """"]" )
  1413. 	End If
  1414. 	DetailsWindow "CD/DVD-ROM Drives and Controllers", gvsDetails
  1415. End Sub
  1416.  
  1417.  
  1418. Sub DetailsCPU( )
  1419. 	gvsDetails = HandleClass( "Win32_Processor", "root/CIMV2" ) & vbCrLf & vbCrLf _
  1420. 	           & HandleClass( "Win32_WinSAT",    "root/CIMV2" )
  1421. 	If gvaSettingsBool.Item( "DXDIAG" ) Then
  1422. 		gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleXMLValue( "/DxDiag/SystemInformation/Processor" )
  1423. 	End If
  1424. 	If gvaSettingsBool.Item( "DMIDECODE" ) Then
  1425. 		gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleDMIDetails( "Processor" )
  1426. 		gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleDMIDetails( "Cache" )
  1427. 	End If
  1428. 	DetailsWindow "CPU", gvsDetails
  1429. End Sub
  1430.  
  1431.  
  1432. Sub DetailsFDD( )
  1433. 	On Error Resume Next ' REQUIRED
  1434. 	gvsDetails = HandleClass( "MSFT_Volume",         "root/Microsoft/Windows/Storage" ) & vbCrLf & vbCrLf _
  1435. 	           & HandleClass( "Win32_LogicalDisk",   "root/CIMV2" ) & vbCrLf & vbCrLf _
  1436. 	           & HandleClass( "Win32_PortConnector", "root/CIMV2" )
  1437. 	DetailsWindow "Floppy Disk Drives and Connectors", gvsDetails
  1438. 	On Error GoTo 0
  1439. End Sub
  1440.  
  1441.  
  1442. Sub DetailsHDD( )
  1443. 	Dim objRE
  1444. 	Set objRE = New RegExp
  1445. 	objRE.Global  = True
  1446. 	objRE.Pattern = vbcrlf & "+"
  1447. 	Set objRE = Nothing
  1448. 	On Error Resume Next ' REQUIRED
  1449. 	gvsDetails = HandleClass( "MSFT_PhysicalDisk",            "root/Microsoft/Windows/Storage" ) & vbCrLf & vbCrLf _
  1450. 	           & HandleClass( "MSFT_Volume",                  "root/Microsoft/Windows/Storage" ) & vbCrLf & vbCrLf _
  1451. 	           & HandleClass( "Win32_DiskDrive",              "root/CIMV2" ) & vbCrLf & vbCrLf _
  1452. 	           & HandleClass( "Win32_LogicalDiskToPartition", "root/CIMV2" ) & vbCrLf & vbCrLf _
  1453. 	           & HandleClass( "Win32_IDEController",          "root/CIMV2" ) & vbCrLf & vbCrLf _
  1454. 	           & HandleClass( "Win32_SCSIController",         "root/CIMV2" ) & vbCrLf & vbCrLf _
  1455. 	           & HandleClass( "Win32_IDEControllerDevice",    "root/CIMV2" ) & vbCrLf & vbCrLf _
  1456. 	           & HandleClass( "Win32_SCSIControllerDevice",   "root/CIMV2" ) & vbCrLf & vbCrLf _
  1457. 	           & HandleClass( "Win32_WinSAT",                 "root/CIMV2" )
  1458. 	If gvaSettingsBool.Item( "DXDIAG" ) Then
  1459. 		gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleXMLNode( "/DxDiag/LogicalDisks/LogicalDisk[Model > """" and FileSystem > """"]" )
  1460. 	End If
  1461. 	DetailsWindow "Disk Drives and Controllers", gvsDetails
  1462. 	On Error Goto 0
  1463. End Sub
  1464.  
  1465.  
  1466. Sub DetailsKeyboard( )
  1467. 	On Error Resume Next ' REQUIRED
  1468. 	gvsDetails = HandleClass( "Win32_Keyboard",             "root/CIMV2" ) & vbCrLf & vbCrLf _
  1469. 	           & HandleClass( "MSKeyboard_PortInformation", "root/WMI"   )
  1470. 	If gvaSettingsBool.Item( "DXDIAG" ) Then
  1471. 		gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleXMLNode( "/DxDiag/DirectInput" )
  1472. 	End If
  1473. 	DetailsWindow "Keyboard", gvsDetails
  1474. 	On Error Goto 0
  1475. End Sub
  1476.  
  1477.  
  1478. Sub DetailsMainBoard( )
  1479. 	gvsDetails = HandleClass( "Win32_BaseBoard",       "root/CIMV2" ) & vbCrLf & vbCrLf _
  1480. 	           & HandleClass( "Win32_SystemEnclosure", "root/CIMV2" ) & vbCrLf & vbCrLf _
  1481. 	           & HandleClass( "Win32_WinSAT",          "root/CIMV2" )
  1482. 	If gvaSettingsBool.Item( "DMIDECODE" ) Then
  1483. 		gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleDMIDetails( "Baseboard" )
  1484. 		gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleDMIDetails( "System" )
  1485. 		gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleDMIDetails( "Chassis" )
  1486. 	End If
  1487. 	DetailsWindow "Main Board and Chassis", gvsDetails
  1488. End Sub
  1489.  
  1490.  
  1491. Sub DetailsMemory( )
  1492. 	gvsDetails = HandleClass( "Win32_PhysicalMemoryArray", "root/CIMV2" ) & vbCrLf & vbCrLf _
  1493. 	           & HandleClass( "Win32_PhysicalMemory",      "root/CIMV2" ) & vbCrLf & vbCrLf _
  1494. 	           & HandleClass( "Win32_WinSAT",              "root/CIMV2" )
  1495. 	If gvaSettingsBool.Item( "DXDIAG" ) Then
  1496. 		gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleXMLValue( "/DxDiag/SystemInformation/Memory" )
  1497. 	End If
  1498. 	If gvaSettingsBool.Item( "DMIDECODE" ) Then
  1499. 		gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleDMIDetails( "Memory" )
  1500. 	End If
  1501. 	DetailsWindow "Memory", gvsDetails
  1502. End Sub
  1503.  
  1504.  
  1505. Sub DetailsMonitor( )
  1506. 	On Error Resume Next ' REQUIRED
  1507. 	gvsDetails = HandleClass( "Win32_DesktopMonitor",         "root/CIMV2" ) & vbCrLf & vbCrLf _
  1508. 	           & HandleClass( "WmiMonitorBasicDisplayParams", "root/WMI"   ) & vbCrLf & vbCrLf _
  1509. 	           & HandleClass( "WmiMonitorID",                 "root/WMI"   ) & vbCrLf & vbCrLf _
  1510. 	           & "<h2>\\" & gvsComputer & "\root\default:StdRegProv</h2>"    & vbcrlf & vbcrlf _
  1511. 	           & "<h3>HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Enum\DISPLAY</h3>"  & vbCrLf & vbCrLf _
  1512. 	           & HandleRegEnum( HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Enum\DISPLAY", 1 )
  1513. 	DetailsWindow "Monitors", gvsDetails
  1514. 	On Error Goto 0
  1515. End Sub
  1516.  
  1517.  
  1518. Sub DetailsMouse( )
  1519. 	On Error Resume Next ' REQUIRED
  1520. 	gvsDetails = HandleClass( "Win32_PointingDevice",       "root/CIMV2" ) & vbCrLf & vbCrLf _
  1521. 	           & HandleClass( "MSMouse_PortInformation",    "root/WMI"   )
  1522. 	If gvaSettingsBool.Item( "DXDIAG" ) Then
  1523. 		gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleXMLNode( "/DxDiag/DirectInput" )
  1524. 	End If
  1525. 	DetailsWindow "Mouse", gvsDetails
  1526. 	On Error Goto 0
  1527. End Sub
  1528.  
  1529.  
  1530. Sub DetailsNIC( )
  1531. 	On Error Resume Next ' REQUIRED
  1532. 	gvsDetails = HandleClass( "MSFT_NetAdapter",                            "root/StandardCimv2" ) & vbCrLf & vbCrLf _
  1533. 	           & HandleClass( "MSFT_NetAdapterAdvancedPropertySettingData", "root/StandardCimv2" ) & vbCrLf & vbCrLf _
  1534. 	           & HandleClass( "Win32_NetworkAdapter",                       "root/CIMV2"         ) & vbCrLf & vbCrLf _
  1535. 	           & HandleClass( "MSNdis_LinkSpeed",                           "root/WMI"           ) & vbCrLf & vbCrLf _
  1536. 	           & HandleClass( "MSNdis_PhysicalMediumType",                  "root/WMI"           )
  1537. 	DetailsWindow "Network Adapter", gvsDetails
  1538. 	On Error Goto 0
  1539. End Sub
  1540.  
  1541.  
  1542. Sub DetailsPorts( )
  1543. 	gvsDetails = HandleClass( "Win32_ParallelPort",            "root/CIMV2" ) & vbCrLf & vbCrLf _
  1544. 	           & HandleClass( "Win32_SerialPort",              "root/CIMV2" ) & vbCrLf & vbCrLf _
  1545. 	           & HandleClass( "Win32_SerialPortConfiguration", "root/CIMV2" ) & vbCrLf & vbCrLf _
  1546. 	           & HandleClass( "Win32_USBController",           "root/CIMV2" ) & vbCrLf & vbCrLf _
  1547. 	           & HandleClass( "Win32_SystemSlot",              "root/CIMV2" ) & vbCrLf & vbCrLf _
  1548. 	           & HandleClass( "Win32_PortConnector",           "root/CIMV2" )
  1549. 	If gvaSettingsBool.Item( "DXDIAG" ) Then
  1550. 		gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleXMLNode( "/DxDiag/SystemDevices/SystemDevice" )
  1551. 	End If
  1552. 	If gvaSettingsBool.Item( "DMIDECODE" ) Then
  1553. 		gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleDMIDetails( "Slot" )
  1554. 		gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleDMIDetails( "Connector" )
  1555. 	End If
  1556. 	DetailsWindow "Ports and Slots", gvsDetails
  1557. End Sub
  1558.  
  1559.  
  1560. Sub DetailsSound( )
  1561. 	gvsDetails = HandleClass( "Win32_SoundDevice", "root/CIMV2" )
  1562. 	gvsDetails = gvsDetails & HandleRegEnum( HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Enum\HDAUDIO", True )
  1563. 	If gvaSettingsBool.Item( "DXDIAG" ) Then
  1564. 		gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleXMLNode( "/DxDiag/DirectSound/SoundDevices/SoundDevice" )
  1565. 	End If
  1566. 	DetailsWindow "Sound Devices", gvsDetails
  1567. End Sub
  1568.  
  1569.  
  1570. Sub DetailsVideo( )
  1571. 	Dim arrSubKeys, i, intResult, objReg, strKey
  1572. 	gvsDetails = HandleClass( "Win32_VideoController",         "root/CIMV2" ) & vbCrLf & vbCrLf _
  1573. 	           & HandleClass( "CIM_VideoControllerResolution", "root/CIMV2" ) & vbCrLf & vbCrLf _
  1574. 	           & HandleClass( "Win32_WinSAT",                  "root/CIMV2" )
  1575. 	Set objReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!//" & gvsComputer & "/root/default:StdRegProv" )
  1576. 	strKey    = "SYSTEM\CurrentControlSet\Control\Class\{4d36e968-e325-11ce-bfc1-08002be10318}"
  1577. 	intResult = objReg.EnumKey( HKEY_LOCAL_MACHINE, strKey, arrSubKeys )
  1578. 	If intResult = 0 Then
  1579. 		For i = 0 To UBound( arrSubKeys )
  1580. 			If IsNumeric( arrSubKeys(i) ) Then
  1581. 				gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleRegEnum( HKEY_LOCAL_MACHINE, strKey & "\" & arrSubKeys(i), 0 )
  1582. 			End If
  1583. 		Next
  1584. 	End If
  1585. 	Set objReg = Nothing
  1586.  
  1587. 	If gvaSettingsBool.Item( "DXDIAG" ) Then
  1588. 		gvsDetails = gvsDetails & vbCrLf & vbCrLf & HandleXMLNode( "/DxDiag/DisplayDevices/DisplayDevice" )
  1589. 	End If
  1590. 	DetailsWindow "Display Adapters", gvsDetails
  1591. End Sub
  1592.  
  1593.  
  1594. Sub DetailsWindow( strCategory, gvsDetails )
  1595. 	Dim objDetailsFile, strHTMLBody, strHTMLFoot, strHTMLHead
  1596.  
  1597. 	strHTMLHead = "<html><head><title>" & strCategory & " details for " & gvsComputer & "</title></head><body>"
  1598. 	strHTMLBody = "<h1 style=""text-align: center;"">" & strCategory & " details for " & gvsComputer & "</h1> <pre style=""font-family: courier,monospace"">" & gvsDetails & "</pre>"
  1599. 	strHTMLFoot = "</body></html>"
  1600.  
  1601. 	' Create a temporary HTML file and open it in the default browser
  1602. 	Set objDetailsFile = gvoFSO.CreateTextFile( gvsDetailsFile )
  1603. 	objDetailsFile.Write( strHTMLHead )
  1604. 	objDetailsFile.Write( strHTMLBody )
  1605. 	objDetailsFile.Write( strHTMLFoot )
  1606. 	objDetailsFile.Close
  1607. 	Set objDetailsFile = Nothing
  1608. 	gvoWSHShell.Run gvsDetailsFile, , False
  1609. End Sub
  1610.  
  1611.  
  1612. Sub EditSettings( )
  1613. 	gvoWSHShell.Run "notepad.exe """ & gvsConfigFile & """", 1, True
  1614. 	ConfigReadFile
  1615. 	ConfigUpdateStatus
  1616. End Sub
  1617.  
  1618.  
  1619. Sub EnableWinSATScores( )
  1620. 	Dim objItem
  1621. 	' Hide WinSAT Score fields if not applicable
  1622. 	For Each objItem In document.all
  1623. 		If objItem.className = "Scores" Then
  1624. 			If gvaSettingsBool.Item( "NOSCORES" ) Or gvbWinPE Then
  1625. 				objItem.style.display    = "none"
  1626. 				objItem.style.visibility = "collapse"
  1627. 			Else
  1628. 				objItem.style.display    = "table-cell"
  1629. 				objItem.style.visibility = "visible"
  1630. 			End If
  1631. 		End If
  1632. 	Next
  1633. End Sub
  1634.  
  1635.  
  1636. Function GetBusType( myInt )
  1637. 	Dim arrBusTypes, strBusType
  1638. 	strBusType = "Unknown"
  1639. 	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", ";" )
  1640. 	If IsNumeric( myInt ) Then
  1641. 		If CInt( myint ) >= 0 And CInt( myInt ) <= UBound( arrBusTypes ) Then
  1642. 			strBusType = arrBusTypes( CInt( myInt ) )
  1643. 		End If
  1644. 	End If
  1645. 	GetBusType = strBusType
  1646. End Function
  1647.  
  1648.  
  1649. Function GetChassis( )
  1650. 	' Based on a script by Guy Thomas http://computerperformance.co.uk/
  1651. 	Dim colChassis, objChassis, strChassis
  1652. 	Set colChassis = gvoWMIrootCimv2.ExecQuery( "Select ChassisTypes from Win32_SystemEnclosure" )
  1653. 	For Each objChassis in colChassis
  1654. 		Select Case objChassis.ChassisTypes(0) ' ChassisTypes is returned as an array of integers
  1655. 			Case 1:
  1656. 				strChassis = "Maybe Virtual Machine"
  1657. 			Case 2:
  1658. 				strChassis = "Unknown"
  1659. 			Case 3:
  1660. 				strChassis = "Desktop"
  1661. 			Case 4:
  1662. 				strChassis = "Thin Desktop"
  1663. 			Case 5:
  1664. 				strChassis = "Pizza Box"
  1665. 			Case  6:
  1666. 				strChassis = "Mini Tower"
  1667. 			Case 7:
  1668. 				strChassis = "Full Tower"
  1669. 			Case 8:
  1670. 				strChassis = "Portable"
  1671. 			Case 9:
  1672. 				strChassis = "Laptop"
  1673. 			Case 10:
  1674. 				strChassis = "Notebook"
  1675. 			Case 11:
  1676. 				strChassis = "Hand Held"
  1677. 			Case 12:
  1678. 				strChassis = "Docking Station"
  1679. 			Case 13:
  1680. 				strChassis = "All in One"
  1681. 			Case 14:
  1682. 				strChassis = "Sub Notebook"
  1683. 			Case 15:
  1684. 				strChassis = "Space-Saving"
  1685. 			Case 16:
  1686. 				strChassis = "Lunch Box"
  1687. 			Case 17:
  1688. 				strChassis = "Main System Chassis"
  1689. 			Case 18:
  1690. 				strChassis = "Lunch Box"
  1691. 			Case 19:
  1692. 				strChassis = "SubChassis"
  1693. 			Case 20:
  1694. 				strChassis = "Bus Expansion Chassis"
  1695. 			Case 21:
  1696. 				strChassis = "Peripheral Chassis"
  1697. 			Case 22:
  1698. 				strChassis = "Storage Chassis"
  1699. 			Case 23:
  1700. 				strChassis = "Rack Mount Unit"
  1701. 			Case 24:
  1702. 				strChassis = "Sealed-Case PC"
  1703. 			Case Else:
  1704. 				strChassis = "Unknown"
  1705. 		End Select
  1706. 	Next
  1707. 	GetChassis = strChassis
  1708. End Function
  1709.  
  1710.  
  1711. Sub GetDefaultBrowser( )
  1712. 	Dim strProgID, wshShell
  1713. 	' Get default browser name
  1714. 	strProgID = gvoWSHShell.RegRead( "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\FileExts\.html\UserChoice\ProgID" )
  1715. 	If InStr( strProgID, "-" ) Then
  1716. 		gvsDefaultBrowserName = Left( strProgID, InStr( strProgID, "-" ) - 1 )
  1717. 	Else
  1718. 		gvsDefaultBrowserName = strProgID
  1719. 	End If
  1720. 	If Right( gvsDefaultBrowserName, 4 ) = "HTML" Then gvsDefaultBrowserName = Left( gvsDefaultBrowserName, Len( gvsDefaultBrowserName ) - 4 )
  1721. 	If Right( gvsDefaultBrowserName, 3 ) = "HTM"  Then gvsDefaultBrowserName = Left( gvsDefaultBrowserName, Len( gvsDefaultBrowserName ) - 3 )
  1722. 	If Right( gvsDefaultBrowserName, 3 ) = "URL"  Then gvsDefaultBrowserName = Left( gvsDefaultBrowserName, Len( gvsDefaultBrowserName ) - 3 )
  1723. 	DebugMessage "", "Default browser name = """ & gvsDefaultBrowserName & """"
  1724. 	' Get default browser path
  1725. 	gvsDefaultBrowserPath = gvoWSHShell.RegRead( "HKEY_CLASSES_ROOT\" & strProgID & "\shell\open\command\" )
  1726. 	If Left( gvsDefaultBrowserPath, 1 ) = """" Then
  1727. 		gvsDefaultBrowserPath = Replace( Left( gvsDefaultBrowserPath, InStr( 2, gvsDefaultBrowserPath, """" ) ), """", "" )
  1728. 	ElseIf Not gvsDefaultBrowserPath = "" And Not gvsDefaultBrowserPath = Null Then
  1729. 		gvsDefaultBrowserPath = Left( gvsDefaultBrowserPath, InStr( gvsDefaultBrowserPath, " " ) - 1 )
  1730. 	End If
  1731. 	DebugMessage "", "Default browser path = """ & gvsDefaultBrowserPath & """"
  1732. End Sub
  1733.  
  1734.  
  1735. Function GetHostName( myComputer )
  1736. 	' This function uses a stripped version of my Hostname.cmd (version 3) batch file to get
  1737. 	' the hostname for the specified computer without requiring WMI access to that computer.
  1738. 	Dim objBatFile, objDatFile, strBatFile, strDatFile, strHostName
  1739. 	strHostName = myComputer
  1740. 	strBatFile  = gvoWSHShell.ExpandEnvironmentStrings( "%Temp%.\~hostname.bat" )
  1741. 	strDatFile  = strBatFile & ".dat"
  1742. 	With gvoFSO
  1743. 		If .FileExists( strBatFile ) Then .DeleteFile strBatFile
  1744. 		If .FileExists( strDatFile ) Then .DeleteFile strDatFile
  1745. 		Set objBatFile = .OpenTextFile( strBatFile, ForWriting, True, TristateFalse )
  1746. 		objBatFile.WriteLine "@ECHO OFF"
  1747. 		objBatFile.WriteLine "SETLOCAL ENABLEDELAYEDEXPANSION"
  1748. 		objBatFile.WriteLine "ECHO ""%~1"" | FIND.EXE "":"" >NUL && SET IPv4=|| SET IPv4=-4"
  1749. 		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)"
  1750. 		objBatFile.WriteLine "ENDLOCAL"
  1751. 		objBatFile.Close
  1752. 		Set objBatFile = Nothing
  1753. 		gvoWSHShell.Run strBatFile & " " & strHostName, 7, True
  1754. 		Sleep 1
  1755. 		.DeleteFile strBatFile
  1756. 		Set objDatFile = .OpenTextFile( strDatFile, ForReading, False, TristateFalse )
  1757. 		strHostName = objDatFile.ReadLine( )
  1758. 		objDatFile.Close
  1759. 		Set objDatFile = Nothing
  1760. 		.DeleteFile strDatFile
  1761. 	End With
  1762. 	GetHostName = strHostName
  1763. End Function
  1764.  
  1765.  
  1766. Function GetLocalComputerName( )
  1767. 	If gvbWinPE Then
  1768. 		GetLocalComputerName = GetLocalComputerNameWinPE( )
  1769. 	Else
  1770. 		GetLocalComputerName = UCase( gvoWSHShell.ExpandEnvironmentStrings( "%ComputerName%" ) )
  1771. 	End If
  1772. End Function
  1773.  
  1774.  
  1775. Function GetLocalComputerNameWinPE( )
  1776. ' Find computer name in WinPE
  1777. ' Based on code by Richie Schuster
  1778. ' http://www.sccmog.com/get-current-old-machine-name-winpe-vbscript/
  1779. ' Caveat: In case of a multi-boot system with multiple computer names, the script
  1780. '         only returns the computer name of the last Windows installation it finds
  1781. 	Dim colItems, objItem, objWMIService
  1782. 	GetLocalComputerNameWinPE = "localhost"
  1783. 	On Error Resume Next ' REQUIRED
  1784. 	' Find the Windows drive
  1785. 	If gvsWinDrive = "" Then
  1786. 		Set objWMIService = GetObject( "winmgmts://./root/CIMV2" )
  1787. 		Set colItems      = objWMIService.ExecQuery ( "SELECT * FROM Win32_LogicalDisk" )
  1788. 		For Each objItem in colItems
  1789. 			If gvoFSO.FolderExists( gvoFSO.BuildPath( objItem.DeviceID, "Windows\System32" ) ) Then
  1790. 				gvsWinDrive = objItem.DeviceID
  1791. 			End If
  1792. 		Next
  1793. 	End If
  1794. 	If gvsWinDrive <> "" Then
  1795. 		' Mount registry hive from Windows drive
  1796. 		gvoWSHShell.Run "CMD.EXE /C REG.EXE Load HKLM\TempHive " & gvsWinDrive & "\windows\system32\config\system", 0, True
  1797. 		' Read computer name from mounted registry hive
  1798. 		GetLocalComputerNameWinPE = UCase( gvoWSHShell.RegRead( "HKEY_LOCAL_MACHINE\TempHive\ControlSet001\Control\ComputerName\ComputerName\ComputerName" ) )
  1799. 		' Unmount registry hive from Windows drive
  1800. 		gvoWSHShell.Run "CMD.EXE /C REG.EXE Load HKLM\TempHive", 0, True
  1801. 	End If
  1802. 	Set colItems      = Nothing
  1803. 	Set objWMIService = Nothing
  1804. 	On Error Goto 0
  1805. End Function
  1806.  
  1807.  
  1808. Function GetMediaType( mtnumber )
  1809. 	Dim strMediaTypeDescription
  1810. 	strMediaTypeDescription = "Unknown"
  1811. 	Select Case mtnumber
  1812. 		Case 1:
  1813. 			strMediaTypeDescription = "5.25 Inch Floppy Disk 1.2 MB"
  1814. 		Case 2:
  1815. 			strMediaTypeDescription = "3.5 Inch Floppy Disk 1.44 MB"
  1816. 		Case 3:
  1817. 			strMediaTypeDescription = "3.5 Inch Floppy Disk 2.88 MB"
  1818. 		Case 4:
  1819. 			strMediaTypeDescription = "3.5 Inch Floppy Disk 20.8 MB"
  1820. 		Case 5:
  1821. 			strMediaTypeDescription = "3.5 Inch Floppy Disk 720 KB"
  1822. 		Case 6:
  1823. 			strMediaTypeDescription = "5.25 Inch Floppy Disk 360 KB"
  1824. 		Case 7:
  1825. 			strMediaTypeDescription = "5.25 Inch Floppy Disk 320 KB"
  1826. 		Case 8:
  1827. 			strMediaTypeDescription = "5.25 Inch Floppy Disk 320 KB"
  1828. 		Case 9:
  1829. 			strMediaTypeDescription = "5.25 Inch Floppy Disk 180 KB"
  1830. 		Case 10:
  1831. 			strMediaTypeDescription = "5.25 Inch Floppy Disk 160 KB"
  1832. 		Case 11:
  1833. 			strMediaTypeDescription = "Removable media other than floppy"
  1834. 		Case 12:
  1835. 			strMediaTypeDescription = "Fixed hard disk media"
  1836. 		Case 13:
  1837. 			strMediaTypeDescription = "3.5 Inch Floppy Disk 120 MB"
  1838. 		Case 14:
  1839. 			strMediaTypeDescription = "3.5 Inch Floppy Disk 640 KB"
  1840. 		Case 15:
  1841. 			strMediaTypeDescription = "5.25 Inch Floppy Disk 640 KB"
  1842. 		Case 16:
  1843. 			strMediaTypeDescription = "5.25 Inch Floppy Disk 720 KB"
  1844. 		Case 17:
  1845. 			strMediaTypeDescription = "3.5 Inch Floppy Disk 1.2 MB"
  1846. 		Case 18:
  1847. 			strMediaTypeDescription = "3.5 Inch Floppy Disk 1.23 MB"
  1848. 		Case 19:
  1849. 			strMediaTypeDescription = "5.25 Inch Floppy Disk 1.23 MB"
  1850. 		Case 20:
  1851. 			strMediaTypeDescription = "3.5 Inch Floppy Disk 128 MB"
  1852. 		Case 21:
  1853. 			strMediaTypeDescription = "3.5 Inch Floppy Disk 230 MB"
  1854. 		Case 22:
  1855. 			strMediaTypeDescription = "8 Inch Floppy Disk 256 KB"
  1856. 		Case Else:
  1857. 			strMediaTypeDescription = "Unknown"
  1858. 	End Select
  1859. 	GetMediaType = strMediaTypeDescription
  1860. End Function
  1861.  
  1862.  
  1863. Function GetMemoryFormFactor( )
  1864. 	Dim colItems, objItem, objWMIService, intFormFactor, strFormFactor, strQuery
  1865. 	intFormFactor = 0
  1866. 	strFormFactor = ""
  1867. 	strQuery = "SELECT FormFactor FROM Win32_PhysicalMemory"
  1868. 	Set objWMIService = GetObject( "winmgmts://" & gvsComputer & "/root/CIMV2"   )
  1869. 	Set colItems = objWMIService.ExecQuery( strQuery )
  1870. 	If Not Err Then
  1871. 		For Each objItem In colItems
  1872. 			intFormFactor = CInt( objItem.FormFactor )
  1873. 		Next
  1874. 	End If
  1875. 	Select Case intFormFactor
  1876. 		Case 0:
  1877. 			strFormFactor = "Unknown"
  1878. 		Case 1:
  1879. 			strFormFactor = "Other"
  1880. 		Case 2:
  1881. 			strFormFactor = "SIP"
  1882. 		Case 3:
  1883. 			strFormFactor = "DIP"
  1884. 		Case 4:
  1885. 			strFormFactor = "ZIP"
  1886. 		Case 5:
  1887. 			strFormFactor = "SOJ"
  1888. 		Case 6:
  1889. 			strFormFactor = "Proprietary"
  1890. 		Case 7:
  1891. 			strFormFactor = "SIMM"
  1892. 		Case 8:
  1893. 			strFormFactor = "DIMM"
  1894. 		Case 9:
  1895. 			strFormFactor = "TSOP"
  1896. 		Case 10:
  1897. 			strFormFactor = "PGA"
  1898. 		Case 11:
  1899. 			strFormFactor = "RIMM"
  1900. 		Case 12:
  1901. 			strFormFactor = "SODIMM"
  1902. 		Case 13:
  1903. 			strFormFactor = "SRIMM"
  1904. 		Case 14:
  1905. 			strFormFactor = "SMD"
  1906. 		Case 15:
  1907. 			strFormFactor = "SSMP"
  1908. 		Case 16:
  1909. 			strFormFactor = "QFP"
  1910. 		Case 17:
  1911. 			strFormFactor = "TQFP"
  1912. 		Case 18:
  1913. 			strFormFactor = "SOIC"
  1914. 		Case 19:
  1915. 			strFormFactor = "LCC"
  1916. 		Case 20:
  1917. 			strFormFactor = "PLCC"
  1918. 		Case 21:
  1919. 			strFormFactor = "BGA"
  1920. 		Case 22:
  1921. 			strFormFactor = "FPBGA"
  1922. 		Case 23:
  1923. 			strFormFactor = "LGA"
  1924. 		Case Else:
  1925. 			strFormFactor = "Unknown"
  1926. 	End Select
  1927. 	GetMemoryFormFactor = strFormFactor
  1928. End Function
  1929.  
  1930.  
  1931. Function GetOSVer( )
  1932. 	Dim arrOS, colItems, objItem, objWMIService
  1933. 	GetOSVer = 0
  1934. 	Set objWMIService = GetObject( "winmgmts://./root/CIMV2" )
  1935. 	Set colItems = objWMIService.ExecQuery( "SELECT Version FROM Win32_OperatingSystem" )
  1936. 	If Not Err Then
  1937. 		For Each objItem In colItems
  1938. 			arrOS = Split( objItem.Version, "." )
  1939. 			If UBound( arrOS ) > 1 Then
  1940. 				GetOSVer = arrOS(0) & "." & arrOS(1)
  1941. 			Else
  1942. 				GetOSVer = arrOS(0)
  1943. 			End If
  1944. 		Next
  1945. 	End If
  1946. 	Set colItems      = Nothing
  1947. 	Set objWMIService = Nothing
  1948. End Function
  1949.  
  1950.  
  1951. Function GetParameter( myString, myParameter )
  1952. 	' Extract switch value from command line,
  1953. 	' e.g. GetParameter( "/CM /SIZE:1024x768 /NOUPD", "SIZE" ) to extract "1024x768"
  1954. 	Dim strItem, strParameter, strString
  1955. 	' Default return value is an empty string
  1956. 	strParameter = UCase( myParameter )
  1957. 	myString     = Trim( myString )
  1958. 	strString    = UCase( myString )
  1959. 	If InStr( strString, "/" & strParameter & ":" ) Then
  1960. 		' Step 1: extract switch and everything following it, e.g. "/SIZE:1024x768 /NOUPD"
  1961. 		strItem = Mid( myString, InStr( strString, "/" & strParameter & ":" ) )
  1962. 		' Check if there is anything following the switch and colon
  1963. 		If Len( strItem ) > Len( "/" & strParameter & ":" ) Then
  1964. 			' Step 2: remove the switch name and colon, e.g. in our example this leaves us with "1024x768 /NOUPD"
  1965. 			strItem = Mid( strItem, Len( "/" & strParameter & ":" ) + 1 )
  1966. 			' Check again if there is anything left to parse
  1967. 			If Len( strItem ) > 1 Then
  1968. 				' Check if the value starts with a doublequote
  1969. 				If Left( strItem, 1 ) = """" Then
  1970. 					' Remove the opening doublequote
  1971. 					strItem = Mid( strItem, 2 )
  1972. 					' Remove the closing doublequote and everything after it
  1973. 					strItem = Left( strItem, InStr( strItem, """" ) - 1 )
  1974. 				Else
  1975. 					' If not in doublequotes, remove the first space and everything following it,
  1976. 					' e.g. in our example this leaves us with "1024x768"
  1977. 					If InStr( strItem, " " ) Then strItem = Left( strItem, InStr( strItem, " " ) - 1 )
  1978. 				End If
  1979. 				' Return the result
  1980. 				GetParameter = Trim( strItem )
  1981. 			End If
  1982. 		End If
  1983. 	End If
  1984. End Function
  1985.  
  1986.  
  1987. Function GetRandomString( myLength )
  1988. 	Dim i, intChar, strResult
  1989. 	strResult = ""
  1990. 	For i = 1 To myLength
  1991. 		intChar = gvoRandom.Next_2( 48, 83 )
  1992. 		If intChar > 57 Then intChar = intChar + 7 ' numbers and captital letters only
  1993. 		strResult = strResult & Chr( intChar )
  1994. 	Next
  1995. 	GetRandomString = strResult
  1996. End Function
  1997.  
  1998.  
  1999. Function GetVideoRAM( myVideoCard )
  2000. 	' UInt32 cannot handle 4GB and greater, so we'll have to look it up in the registry
  2001. 	' Based on PowerShell code by "farag" at
  2002. 	' https://superuser.com/questions/1461858/fetch-correct-vram-for-gpu-via-command-line-on-windows/1497378#1497378
  2003. 	' Corrected for remote computers AND for multiple video controllers AND for both integrated and discrete video controllers by Steve Robertson
  2004. 	Dim arrSubKeys
  2005. 	Dim binVidMem
  2006. 	Dim i, intRegKeyCount, lngVidMem
  2007. 	Dim objReg
  2008. 	Dim strAdapterName, strRegKey, strSubKey, strVidMem
  2009.  
  2010. 	lngVidMem   = 0
  2011.  
  2012. 	strRegKey = "SYSTEM\CurrentControlSet\Control\Class\{4d36e968-e325-11ce-bfc1-08002be10318}"
  2013. 	Set objReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!//" & gvaSettingsStr.Item( "COMPUTER" ) & "/root/default:StdRegProv" )
  2014. 	If objReg.EnumKey( HKEY_LOCAL_MACHINE, strRegKey, arrSubKeys ) = 0 Then
  2015. 		For intRegKeyCount = 0 To UBound( arrSubKeys )
  2016. 			If IsNumeric( arrSubKeys( intRegKeyCount ) ) Then
  2017. 				strSubKey = strRegKey & "\" & Right( "0000" & intRegKeyCount, 4 )
  2018. 				If objReg.GetStringValue( HKEY_LOCAL_MACHINE, strSubKey, "DriverDesc", strAdapterName ) = 0 Then
  2019. 					If strAdapterName = myVideoCard Then
  2020. 						' If a value is specified for HardwareInformation.qwMemorySize, the memory size is 4GB or more and we can ignore HardwareInformation.MemorySize
  2021. 						If objReg.GetQWORDValue( HKEY_LOCAL_MACHINE, strSubKey, "HardwareInformation.qwMemorySize", lngVidMem ) = 0 Then
  2022. 							' lngVidMem contains the amount of video RAM in bytes
  2023. 						ElseIf objReg.GetDWORDValue( HKEY_LOCAL_MACHINE, strSubKey, "HardwareInformation.MemorySize", lngVidMem ) = 0 Then
  2024. 							' lngVidMem contains the amount of video RAM in bytes
  2025. 						ElseIf objReg.GetBinaryValue( HKEY_LOCAL_MACHINE, strSubKey, "HardwareInformation.MemorySize", binVidMem ) = 0 Then
  2026. 							' binVidMem contains the amount of video RAM in MB and specified in a binary array
  2027. 							strVidMem = ""
  2028. 							For i = 0 To UBound( binVidMem )
  2029. 								strVidMem = strVidMem & binVidMem( i )
  2030. 							Next
  2031. 							lngVidMem = Int( strVidMem ) * MB
  2032. 						Else
  2033. 							lngVidMem = 0
  2034. 						End If
  2035. 					End If
  2036. 				End If
  2037. 			End If
  2038. 		Next
  2039. 	Else
  2040. 		Exit Function
  2041. 	End If
  2042. 	Set objReg = Nothing
  2043. 	GetVideoRAM = Round( lngVidMem / MB )
  2044. End Function
  2045.  
  2046.  
  2047. Function HandleClass( myClass, myNameSpace )
  2048. ' This subroutine lists all properties and their values for a specified class.
  2049. ' Created using an example from a Microsoft TechNet ScriptCenter article:
  2050. ' http://www.microsoft.com/technet/scriptcenter/resources/guiguy/default.mspx
  2051. 	Dim blnNumChain, colItems, intChar, intPadding, intTest, objClass, objItem, objProperty, objWMIService2, strPadding, strProperties
  2052.  
  2053. 	On Error Resume Next ' REQUIRED
  2054.  
  2055. 	strProperties = "<h2>\\" & gvsComputer & "\" & Replace( myNameSpace, "/", "\" ) & ":" & myClass & "</h2>" & vbCrLf & vbCrLf
  2056.  
  2057. 	If LCase( myNameSpace ) = "root/cimv2" Then
  2058. 		Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM " & myClass )
  2059. 		Set objClass = gvoWMIrootCimv2.Get( myClass )
  2060. 		If Err Then
  2061. 			HandleClass = strProperties & "<p>Error while trying to query \\" & gvsComputer & "\root\CIMV2\" & myClass & "</p>" & vbCrLf & vbCrLf
  2062. 			Exit Function
  2063. 		End If
  2064. 	ElseIf LCase( myNameSpace ) = "root/wmi" Then
  2065. 		Set colItems = gvoWMIrootWMI.ExecQuery( "SELECT * FROM " & myClass )
  2066. 		Set objClass = gvoWMIrootWMI.Get( myClass )
  2067. 		If Err Then
  2068. 			HandleClass = strProperties & "<p>Error while trying to query \\" & gvsComputer & "\root\WMI\" & myClass & "</p>" & vbCrLf & vbCrLf
  2069. 			Exit Function
  2070. 		End If
  2071. 	ElseIf LCase( myNameSpace ) = "root/standardcimv2" Then
  2072. 		Set colItems = gvoWMIrootStandardCimv2.ExecQuery( "SELECT * FROM " & myClass )
  2073. 		Set objClass = gvoWMIrootStandardCimv2.Get( myClass )
  2074. 		If Err Then
  2075. 			HandleClass = strProperties & "<p>Error while trying to query \\" & gvsComputer & "\root\StandardCimv2\" & myClass & "</p>" & vbCrLf & vbCrLf
  2076. 			Exit Function
  2077. 		End If
  2078. 	Else
  2079. 		Set objWMIService2 = GetObject( "winmgmts://" & gvsComputer & "/" & myNameSpace )
  2080. 		If Err Then
  2081. 			HandleClass = strProperties & "<p>Error while trying to connect to \\" & gvsComputer & "\" & Replace( myNameSpace, "/", "\" ) & "</p>" & vbCrLf & vbCrLf
  2082. 			Exit Function
  2083. 		End If
  2084. 		Set colItems = objWMIService2.ExecQuery( "SELECT * FROM " & myClass )
  2085. 		Set objClass = objWMIService2.Get( myClass )
  2086. 		If Err Then
  2087. 			HandleClass = strProperties & "<p>Error while trying to query \\" & gvsComputer & "\" & Replace( myNameSpace, "/", "\" ) & "\" & myClass & "</p>" & vbCrLf & vbCrLf
  2088. 			Exit Function
  2089. 		End If
  2090. 	End If
  2091.  
  2092. 	Select Case colItems.Count
  2093. 		Case 0
  2094. 			strProperties = strProperties & "<p>No instances.</p>" & vbCrLf & vbCrLf
  2095. 		Case 1
  2096. 			strProperties = strProperties & "<p>1 instance:</p>" & vbCrLf & vbCrLf
  2097. 		Case Else
  2098. 			strProperties = strProperties & "<p>" & colItems.Count & " instances:</p>" & vbCrLf & vbCrLf
  2099. 	End Select
  2100.  
  2101. 	For Each objItem In colItems
  2102. 		intPadding = 1
  2103. 		For Each objProperty In objClass.Properties_
  2104. 			intPadding = Max( intPadding, Len( CreateLine( objProperty.Name ) ) )
  2105. 		Next
  2106. 		strpadding = Space( intPadding )
  2107. 		For Each objProperty In objClass.Properties_
  2108. 			If objProperty.IsArray = True Then
  2109. 				blnNumChain = True
  2110. 				intTest     = 0
  2111. 				For Each intChar In Eval( "objItem." & objProperty.Name )
  2112. 					If IsNumeric( intChar ) Then
  2113. 						intTest = intTest + intChar
  2114. 					Else
  2115. 						blnNumChain = False
  2116. 						Exit For
  2117. 					End If
  2118. 				Next
  2119. 				If blnNumChain And gvaSettingsBool.Item( "CHAIN" ) And ( intTest > 0 ) And ( InStr( objProperty.Name, "Characteristic" ) < 1 ) And ( InStr( objProperty.Name, "Capabilit" ) < 1 ) Then
  2120. 					strProperties = strProperties & Left( CreateLine( objProperty.Name & " (array)"  ) & strPadding, intPadding ) & " : " & Eval( "Join( objItem." & objProperty.Name & ", "","" )" ) & vbCrLf
  2121. 					strProperties = strProperties & Left( CreateLine( objProperty.Name & " (string)" ) & strPadding, intPadding ) & " : " & Eval( "Chain( objItem." & objProperty.Name & " )" ) & vbCrLf
  2122. 				Else
  2123. 					strProperties = strProperties & Left( CreateLine( objProperty.Name ) & strPadding, intPadding ) & " : " & Eval( "Join( objItem." & objProperty.Name & ", "","" )" ) & vbCrLf
  2124. 				End If
  2125. 			Else
  2126. 				If IsDate( Eval( "objItem." & objProperty.Name ) ) Then
  2127. 					strProperties = strProperties & Left( CreateLine( objProperty.Name ) & strPadding, intPadding ) & " : " & FormatDateTime( Eval( "objItem." & objProperty.Name ) ) & vbCrLf
  2128. 				Else
  2129. 					strProperties = strProperties & Left( CreateLine( objProperty.Name ) & strPadding, intPadding ) & " : " & Eval( "objItem." & objProperty.Name ) & vbCrLf
  2130. 				End If
  2131. 			End If
  2132. 		Next
  2133. 		strProperties = strProperties & vbCrLf & vbCrLf
  2134. 	Next
  2135.  
  2136. 	Set objWMIService2 = Nothing
  2137.  
  2138. 	On Error Goto 0
  2139.  
  2140. 	HandleClass = strProperties
  2141. End Function
  2142.  
  2143.  
  2144. Function HandleDMIDetails( myType )
  2145. 	Dim objCMD, strMsg, strOutput
  2146. 	HandleDMIDetails = ""
  2147. 	If gvbWinPE Then Exit Function
  2148. 	On Error Resume Next ' REQUIRED
  2149. 	Set objCMD = gvoWSHShell.Exec( "CMD.EXE /C """ & gvsDMIDecode & """ --type " & LCase( myType ) & " 2>&1" )
  2150. 	strOutput = objCMD.StdOut.ReadAll
  2151. 	objCMD.Terminate
  2152. 	Set objCMD = Nothing
  2153. 	On Error Goto 0
  2154. 	HandleDMIDetails = "<h2>\\" & gvsComputer & " " & "DMI " & myType & " details</h2>" & vbCrLf & vbCrLf & "<pre>" & strOutput & "</pre>" & vbCrLf
  2155. End Function
  2156.  
  2157.  
  2158. Function HandleRegEnum( myHive, myRegPath, myRecursion )
  2159. 	Dim arrSubkeys, arrValueNames, arrValueTypes
  2160. 	Dim blnRecursion
  2161. 	Dim i, intMaxTypeLen, intMaxNameLen, intResult
  2162. 	Dim objReg
  2163. 	Dim strData, strHive, strResult
  2164. 	Dim varData
  2165. 	blnRecursion = ( myRecursion <> 0 )
  2166. 	strResult     = ""
  2167. 	intMaxTypeLen = 0
  2168. 	intMaxNameLen = 0
  2169. 	Select Case myHive
  2170. 		Case HKEY_CLASSES_ROOT
  2171. 			strHive = "HKEY_CLASSES_ROOT"
  2172. 		Case HKEY_CURRENT_USER
  2173. 			strHive = "HKEY_CURRENT_USER"
  2174. 		Case HKEY_LOCAL_MACHINE
  2175. 			strHive = "HKEY_LOCAL_MACHINE"
  2176. 		Case HKEY_USERS
  2177. 			strHive = "HKEY_USERS"
  2178. 		Case HKEY_CURRENT_CONFIG
  2179. 			strHive = "HKEY_CURRENT_CONFIG"
  2180. 		Case Else
  2181. 			strHive = myHive
  2182. 	End Select
  2183. 	On Error Resume Next ' REQUIRED
  2184. 	Set objReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!//" & gvsComputer & "/root/default:StdRegProv" )
  2185. 	strResult = "<h2>[" & strHive & "\" & myRegPath & "]</h2>" & vbCrLf
  2186. 	intResult = objReg.EnumValues( myHive, myRegPath, arrValueNames, arrValueTypes )
  2187. 	If intResult = 0 Then
  2188. 		If IsArray( arrValueNames ) And IsArray( arrValueTypes ) Then
  2189. 			For i = 0 To UBound( arrValueNames )
  2190. 				If Len( arrValueNames(i) )                 > intMaxNameLen Then intMaxNameLen = Len( arrValueNames(i) )
  2191. 				If Len( gvaRegDataType(arrValueTypes(i)) ) > intMaxTypeLen Then intMaxTypeLen = Len( gvaRegDataType(arrValueTypes(i)) )
  2192. 			Next
  2193. 			For i = 0 To UBound( arrValueNames )
  2194. 				strData = ""
  2195. 				Select Case arrValueTypes(i)
  2196. 					Case REG_SZ:
  2197. 						intResult = objReg.GetStringValue( myHive, myRegPath, arrValueNames(i), strData )
  2198. 					Case REG_EXPAND_SZ:
  2199. 						intResult = objReg.GetExpandedStringValue( myHive, myRegPath, arrValueNames(i), strData )
  2200. 					Case REG_BINARY:
  2201. 						intResult = objReg.GetBinaryValue( myHive, myRegPath, arrValueNames(i), varData )
  2202. 						If Not Err And IsArray( varData ) Then
  2203. 							strData = Join( varData, ";" )
  2204. 						End If
  2205. 					Case REG_DWORD, REG_DWORD_BIG_ENDIAN:
  2206. 						intResult = objReg.GetDWORDValue( myHive, myRegPath, arrValueNames(i), varData )
  2207. 						strData = "0x" & Right( String( 8, "0" ) & CStr( Hex( varData ) ), 8 ) & " (" & varData & ")"
  2208. 					Case REG_MULTI_SZ:
  2209. 						intResult = objReg.GetMultiStringValue( myHive, myRegPath, arrValueNames(i), varData )
  2210. 						strData = Join( varData, ";" )
  2211. 					Case REG_QWORD:
  2212. 						intResult = objReg.GetQWORDValue( myHive, myRegPath, arrValueNames(i), varData )
  2213. 						strData = "0x" & Right( String( 16, "0" ) & CStr( Hex( varData ) ), 16 ) & " (" & varData & ")"
  2214. 				End Select
  2215. 				If intResult = 0 Then
  2216. 					strResult = strResult & Left( arrValueNames(i) & Space( intMaxNameLen + 4 ), intMaxNameLen + 4) & Left( "[" & gvaRegDataType(arrValueTypes(i)) & "]" & Space( intMaxTypeLen + 4 ), intMaxTypeLen + 4 ) & strData & vbCrLf
  2217. 				End If
  2218. 			Next
  2219. 		End If
  2220. 	End If
  2221.  
  2222. 	If blnRecursion And intResult = 0 Then
  2223. 		strResult = strResult & vbCrLf
  2224. 		objReg.EnumKey myHive, myRegPath, arrSubkeys
  2225. 		If Not Err And IsArray( arrSubkeys ) Then
  2226. 			For i = 0 To UBound( arrSubkeys )
  2227. 				strResult = strResult & HandleRegEnum( myHive, myRegPath & "\" & arrSubkeys(i), 1 )
  2228. 			Next
  2229. 		End If
  2230. 	End If
  2231. 	Set objReg = Nothing
  2232. 	On Error Goto 0
  2233. 	HandleRegEnum = strResult
  2234. End Function
  2235.  
  2236.  
  2237. Function HandleXMLNode( myQuery )
  2238. 	Dim i, strDeviceType, strMsg, strQuery2
  2239. 	Dim colNodes, colNodes2, objNode, objNode2, objNode3, objNode4, objNode5, objNode6, xmlDoc
  2240. 	HandleXMLNode = ""
  2241. 	If gvbWinPE Then Exit Function
  2242. 	strDeviceType = Left( myQuery, InStrRev( myQuery, "/" ) - 1 )
  2243. 	strDeviceType = Mid( strDeviceType, InStrRev( strDeviceType, "/" ) + 1 )
  2244. 	strMsg        = "<h2>\\" & gvsComputer & " " & "DxDiag " & strDeviceType & " data</h2>" & vbCrLf & vbCrLf
  2245. 	On Error Resume Next ' REQUIRED
  2246. 	Set xmlDoc = CreateObject( "Microsoft.XMLDOM" )
  2247. 	xmlDoc.Async = "False"
  2248. 	xmlDoc.Load gvaSettingsStr.Item( "XML" )
  2249. 	Set colNodes = xmlDoc.selectNodes( myQuery )
  2250. 	Select Case colNodes.length
  2251. 		Case 0
  2252. 			strMsg = strMsg & "<p>No instances.</p>"
  2253. 		Case 1
  2254. 			strMsg = strMsg & "<p>1 instance:</p>"
  2255. 		Case Else
  2256. 			strMsg = strMsg & "<p>" & colNodes.length & " instances:</p>"
  2257. 	End Select
  2258. 	strMsg = strMsg & vbCrLf & vbCrLf & "<pre>"
  2259. 	For i = 0 To colNodes.length - 1
  2260. 		strQuery2 = myQuery & "[" & i & "]/*"
  2261. 		Set colNodes2 = xmlDoc.selectNodes( strQuery2 )
  2262. 		For Each objNode2 in colNodes2
  2263. 			If objNode2.childNodes.length = 1 Then
  2264. 				strMsg = strMsg & objNode2.nodeName & " = " & objNode2.text & vbCrLf
  2265. 			Else
  2266. 				strMsg = strMsg & objNode2.nodeName & ":" & vbCrLf
  2267. 				For Each objNode3 In objNode2.childNodes
  2268. 					If objNode3.childNodes.length = 1 Then
  2269. 						strMsg = strMsg & "  " & objNode3.nodeName & " = " & objNode3.text & vbCrLf
  2270. 					Else
  2271. 						strMsg = strMsg & objNode3.nodeName & ":" & vbCrLf
  2272. 						For Each objNode4 In objNode3.childNodes
  2273. 							If objNode4.childNodes.length = 1 Then
  2274. 								strMsg = strMsg & "  " & objNode4.nodeName & " = " & objNode4.text & vbCrLf
  2275. 							Else
  2276. 								strMsg = strMsg & objNode4.nodeName & ":" & vbCrLf
  2277. 								For Each objNode5 In objNode4.childNodes
  2278. 									If objNode5.childNodes.length = 1 Then
  2279. 										strMsg = strMsg & "  " & objNode5.nodeName & " = " & objNode5.text & vbCrLf
  2280. 									Else
  2281. 										strMsg = strMsg & objNode5.nodeName & ":" & vbCrLf
  2282. 										For Each objNode6 In objNode5.childNodes
  2283. 											strMsg = strMsg & "  " & objNode6.nodeName & " = " & objNode6.text & vbCrLf
  2284. 										Next
  2285. 									End If
  2286. 								Next
  2287. 							End If
  2288. 						Next
  2289. 					End If
  2290. 				Next
  2291. 			End If
  2292. 		Next
  2293. 		strMsg = strMsg & vbCrLf & vbCrLf
  2294. 	Next
  2295. 	strMsg = strMsg & "</pre>" & vbCrLf
  2296. 	Set colNodes2 = Nothing
  2297. 	Set colNodes  = Nothing
  2298. 	Set xmlDoc    = Nothing
  2299. 	On Error Goto 0
  2300. 	HandleXMLNode = strMsg
  2301. End Function
  2302.  
  2303.  
  2304. Function HandleXMLValue( myQuery )
  2305. 	Dim i, strDeviceType, strMsg, strQuery2
  2306. 	Dim colNodes, colNodes2, objNode, objNode2, objNode3, xmlDoc
  2307. 	HandleXMLValue = ""
  2308. 	If gvbWinPE Then Exit Function
  2309. 	strDeviceType  = Left( myQuery, InStrRev( myQuery, "/" ) - 1 )
  2310. 	strDeviceType  = Mid( strDeviceType, InStrRev( strDeviceType, "/" ) + 1 )
  2311. 	strMsg         = "<h2>\\" & gvsComputer & " " & "DxDiag " & strDeviceType & " data</h2>" & vbCrLf & vbCrLf
  2312. 	On Error Resume Next ' REQUIRED
  2313. 	Set xmlDoc = CreateObject( "Microsoft.XMLDOM" )
  2314. 	xmlDoc.Async = "False"
  2315. 	xmlDoc.Load gvaSettingsStr.Item( "XML" )
  2316. 	Set colNodes = xmlDoc.selectNodes( myQuery )
  2317. 	Select Case colNodes.length
  2318. 		Case 0
  2319. 			strMsg = strMsg & "<p>No instances.</p>"
  2320. 		Case 1
  2321. 			strMsg = strMsg & "<p>1 instance:</p>"
  2322. 		Case Else
  2323. 			strMsg = strMsg & "<p>" & colNodes.length & " instances:</p>"
  2324. 	End Select
  2325. 	strMsg = strMsg & vbCrLf & vbCrLf & "<pre>"
  2326. 	For i = 0 To colNodes.length - 1
  2327. 		strQuery2 = myQuery & "[" & i & "]"
  2328. 		Set colNodes2 = xmlDoc.selectNodes( strQuery2 )
  2329. 		For Each objNode2 in colNodes2
  2330. 			strMsg = strMsg & objNode2.nodeName & " #" & i & " : " & objNode2.text & vbCrLf
  2331. 		Next
  2332. 		strMsg = strMsg & vbCrLf & vbCrLf
  2333. 	Next
  2334. 	strMsg = strMsg & "</pre>" & vbCrLf
  2335. 	Set colNodes2 = Nothing
  2336. 	Set colNodes  = Nothing
  2337. 	Set xmlDoc    = Nothing
  2338. 	On Error Goto 0
  2339. 	HandleXMLValue = strMsg
  2340. End Function
  2341.  
  2342.  
  2343. Sub Initialize( )
  2344. 	Dim i, j, k, objRE
  2345. 	' Read PATH
  2346. 	gvsPATH = Trim( gvoWSHShell.ExpandEnvironmentStrings( "%PATH%" ) )
  2347. 	' Remove empty PATH entries
  2348. 	Set objRE = New RegExp
  2349. 	objRE.Pattern = ";\s+"
  2350. 	gvsPATH = Trim( objRE.Replace( gvsPATH, ";" ) )
  2351. 	objRE.Pattern = ";{2,}"
  2352. 	gvsPATH = Trim( objRE.Replace( gvsPATH, ";" ) )
  2353. 	objRE.Pattern = "(^;|;$)"
  2354. 	gvsPATH = Trim( objRE.Replace( gvsPATH, "" ) )
  2355. 	Set objRE = Nothing
  2356. 	' Split PATH into array of entries
  2357. 	gvaPATH = Split( gvsPATH, ";" )
  2358. 	k = UBound( gvaPATH )
  2359. 	' Trim PATH entries
  2360. 	For i = UBound( gvaPATH ) To 0 Step -1
  2361. 		gvaPATH(i) = Trim( gvaPATH(i) )
  2362. 		' Remove empty PATH entries
  2363. 		If gvaPATH(i) = "" Then
  2364. 			For j = i To k - 1
  2365. 				gvaPATH(j) = gvaPATH(j+1)
  2366. 			Next
  2367. 			k = k - 1
  2368. 		End If
  2369. 	Next
  2370. 	' Resize PATH array to account for removed entries
  2371. 	If k < UBound( gvaPATH ) Then
  2372. 		ReDim Preserve gvaPATH(k)
  2373. 	End If
  2374. 	' Check if in WinPE
  2375. 	gvbWinPE = CheckWinPE( )
  2376. 	If gvbWinPE Then DebugMessage "", "Running in WinPE"
  2377. 	' Reset counters
  2378. 	gvcBanks     = 0
  2379. 	gvcCPU       = 0
  2380. 	gvcMemory    = 0
  2381. 	gviMemSize   = 0
  2382. 	gviMemSpeed  = 0
  2383. 	gviNumOS     = 0
  2384. 	gviMinHeight = Min( 600, window.screen.height )
  2385. 	gviMinWidth  = Min( 800, window.screen.width  )
  2386. 	' Color changes on WMI connection errors
  2387. 	clrBgErr  = "Red"
  2388. 	clrTxtErr = "White"
  2389. 	' This HTA's command line
  2390. 	gvsCommandline   = Hardware.CommandLine
  2391. 	gvsCommandlineUC = UCase( gvsCommandline )
  2392. 	' Create a list of all interface colors available, and fill the theme settings dropdowns with them
  2393. 	ListCSSColors
  2394. 	ListColors "BackgroundColor",     "blue"
  2395. 	ListColors "CaptionsColor",       "white"
  2396. 	ListColors "LinksColor",          "red"
  2397. 	ListColors "ButtonFaceColor",     "silver"
  2398. 	ListColors "ButtonCaptionsColor", "blacl"
  2399. 	ListColors "CodeColor",           "yellow"
  2400. 	' Dictionary objects for global settings
  2401. 	Set gvaDefaultsBool = CreateObject( "Scripting.Dictionary" )
  2402. 	Set gvaDefaultsStr  = CreateObject( "Scripting.Dictionary" )
  2403. 	Set gvaSettingsBool = CreateObject( "Scripting.Dictionary" )
  2404. 	Set gvaSettingsStr  = CreateObject( "Scripting.Dictionary" )
  2405. 	' Read and set defaults
  2406. 	ConfigReadDefaults
  2407. 	' Paths of helper files
  2408. 	gvsConfigFile    = Left( Self.location.pathname, Len( Self.location.pathname ) - 4 ) & ".cfg"
  2409. 	gvsDetailsFile   = gvoFSO.BuildPath( gvaSettingsStr.Item( "TEMPDIR" ), "~hardware~details.html" )
  2410. 	gvsPrintFile     = gvoFSO.BuildPath( gvaSettingsStr.Item( "TEMPDIR" ), "~hardware~print~preview.html" )
  2411. 	gvsDebugText     = ""
  2412. End Sub
  2413.  
  2414.  
  2415. Sub Inventory( )
  2416. 	Dim blnSuccess, colItems, i, objItem, objWMIService
  2417.  
  2418. 	'ComputerName.value = gvsComputer
  2419. 	gvsComputer = UCase( Trim( ComputerName.value ) )
  2420.  
  2421. 	If ComputerName.value <> UCase( gvsComputer ) Then
  2422. 		If gvsComputer <> "" Then
  2423. 			DebugMessage "", "Changing computer name from " & gvsComputer & " to " & Trim( ComputerName.value )
  2424. 		End If
  2425. 	End If
  2426.  
  2427. 	ComputerName.style.backgroundColor = "White"
  2428. 	ComputerName.style.color           = "Black"
  2429. 	ComputerName.disabled              = True
  2430.  
  2431. 	gvbIsLocalComputer = IsLocalComputer( )
  2432.  
  2433.     If ButtonRun.value = "Reset" Then
  2434.     	Reset
  2435.     Else
  2436. 	    ButtonRun.value            = "Reset"
  2437. 	    ButtonRun.accessKey        = "r"
  2438. 	    ButtonRun.title            = "Click here to clear all fields"
  2439. 	    ButtonRun.disabled         = True
  2440. 		CheckboxBIOS.disabled      = True
  2441. 		CheckboxCDROM.disabled     = True
  2442. 		CheckboxCPU.disabled       = True
  2443. 		CheckboxFDD.disabled       = True
  2444. 		CheckboxHDD.disabled       = True
  2445. 		CheckboxKeyboard.disabled  = True
  2446. 		CheckboxMouse.disabled     = True
  2447. 		CheckboxMainBoard.disabled = True
  2448. 		CheckboxMemory.disabled    = True
  2449. 		CheckboxMonitor.disabled   = True
  2450. 		CheckboxNIC.disabled       = True
  2451. 		CheckboxPorts.disabled     = True
  2452. 		CheckboxSound.disabled     = True
  2453. 		CheckboxVideo.disabled     = True
  2454. 		ButtonBasic.disabled       = True
  2455. 		ButtonPaste.disabled       = True
  2456. 		ButtonPrint.disabled       = True
  2457. 		ComputerName.disabled      = True
  2458.  
  2459. 		If Not CheckboxBIOS.Checked Then
  2460. 			BIOSHeader.style.display = "none"
  2461. 			BIOSRow.style.display    = "none"
  2462. 			BIOSFooter.style.display = "none"
  2463. 		End If
  2464. 		If Not CheckboxCDROM.Checked Then
  2465. 			CDROMHeader.style.display = "none"
  2466. 			CDROM0.style.display      = "none"
  2467. 			CDROMFooter.style.display = "none"
  2468. 		End If
  2469. 		If Not CheckboxCPU.Checked Then
  2470. 			CPUHeader.style.display = "none"
  2471. 			CPURow.style.display    = "none"
  2472. 			CPUFooter.style.display = "none"
  2473. 		End If
  2474. 		If Not CheckboxFDD.Checked Then
  2475. 			FDDHeader.style.display = "none"
  2476. 			FDD0.style.display      = "none"
  2477. 			FDDFooter.style.display = "none"
  2478. 		End If
  2479. 		If Not CheckboxHDD.Checked Then
  2480. 			HardDiskHeader.style.display = "none"
  2481. 			HardDisk0.style.display      = "none"
  2482. 			HardDiskFooter.style.display = "none"
  2483. 		End If
  2484. 		If Not CheckboxKeyboard.Checked Then
  2485. 			KeyboardHeader.style.display = "none"
  2486. 			KeyboardRow.style.display    = "none"
  2487. 			KeyboardFooter.style.display = "none"
  2488. 		End If
  2489. 		If Not CheckboxMainBoard.Checked Then
  2490. 			MainBoardHeader.style.display = "none"
  2491. 			MainBoardRow.style.display    = "none"
  2492. 			MainBoardFooter.style.display = "none"
  2493. 		End If
  2494. 		If Not CheckboxMemory.Checked Then
  2495. 			MemHeader.style.display = "none"
  2496. 			MemRow.style.display    = "none"
  2497. 			MemFooter.style.display = "none"
  2498. 		End If
  2499. 		If Not CheckboxMonitor.Checked Then
  2500. 			MonitorHeader.style.display = "none"
  2501. 			Monitor0.style.display      = "none"
  2502. 			MonitorFooter.style.display = "none"
  2503. 		End If
  2504. 		If Not CheckboxMouse.Checked Then
  2505. 			MouseHeader.style.display = "none"
  2506. 			MouseRow.style.display    = "none"
  2507. 			MouseFooter.style.display = "none"
  2508. 		End If
  2509. 		If Not CheckboxNIC.Checked Then
  2510. 			NICHeader.style.display = "none"
  2511. 			NIC0.style.display      = "none"
  2512. 			NICFooter.style.display = "none"
  2513. 		End If
  2514. 		If Not CheckboxPorts.Checked Then
  2515. 			PortsHeader.style.display = "none"
  2516. 			PortsRow.style.display    = "none"
  2517. 			PortsFooter.style.display = "none"
  2518. 		End If
  2519. 		If Not CheckboxSound.Checked Then
  2520. 			SoundHeader.style.display = "none"
  2521. 			SoundRow.style.display    = "none"
  2522. 			SoundFooter.style.display = "none"
  2523. 		End If
  2524. 		If Not CheckboxVideo.Checked Then
  2525. 			VideoHeader.style.display = "none"
  2526. 			Video0.style.display      = "none"
  2527. 			VideoFooter.style.display = "none"
  2528. 		End If
  2529.  
  2530. 		DebugMessage "", "Starting inventory"
  2531.  
  2532. 		On Error Resume Next ' REQUIRED
  2533.  
  2534. 		If gvbWinPE Then
  2535. 			gvsComputer        = UCase( InputBox( "Please enter the computer name", "Computer Name", gvsComputer ) )
  2536. 			ComputerName.value = gvsComputer
  2537. 			Set gvoWMIrootCimv2         = GetObject( "winmgmts://./root/CIMV2" )
  2538. 			Set gvoWMIrootMSWinStorage  = GetObject( "winmgmts://./root/Microsoft/Windows/Storage" )
  2539. 			Set gvoWMIrootStandardCimv2 = GetObject( "winmgmts://./root/StandardCimv2" )
  2540. 			Set gvoWMIrootWMI           = GetObject( "winmgmts://./root/WMI" )
  2541. 		Else
  2542. 			gvsComputer = ComputerName.value
  2543. 			If gvsComputer = "" Or gvsComputer = "." Then
  2544. 				gvsComputer        = GetLocalComputerName( )
  2545. 				ComputerName.value = gvsComputer
  2546. 			End If
  2547. 			Sleep 1
  2548. 			Set colItems = gvoWMIlocalCimv2.ExecQuery( "SELECT StatusCode FROM Win32_PingStatus WHERE Address='" & gvsComputer & "'" )
  2549. 			For Each objItem In colItems
  2550. 				If IsNull( objItem.StatusCode ) Or objItem.StatusCode <> 0 Then
  2551. 					On Error GoTo 0
  2552. 					MsgBox "Error while trying to ping computer " & gvsComputer, vbOKOnly, "Connection Error"
  2553. 					Reset
  2554. 					Exit Sub
  2555. 				End If
  2556. 			Next
  2557. 			Set gvoWMIrootCimv2 = GetObject( "winmgmts://" & gvsComputer & "/root/CIMV2" )
  2558. 			If Err Then
  2559. 				MsgBox "Error " & Err.Number & " while trying to get access to " & gvsComputer & ": " & Err.Description, vbOKOnly, "Remote WMI Error"
  2560. 				On Error GoTo 0
  2561. 				Reset
  2562. 				Exit Sub
  2563. 			End If
  2564. 			Set gvoWMIrootMSWinStorage  = GetObject( "winmgmts://" & gvsComputer & "/root/Microsoft/Windows/Storage" )
  2565. 			Set gvoWMIrootStandardCimv2 = GetObject( "winmgmts://" & gvsComputer & "/root/StandardCimv2" )
  2566. 			Set gvoWMIrootWMI           = GetObject( "winmgmts://" & gvsComputer & "/root/WMI" )
  2567. 		End If
  2568.  
  2569. 		' Diable WinSAT for Windows XP and older
  2570. 		If CInt( Left( CStr( gviNumOS ), 1 ) ) < 6 Then gvaDefaultsBool.Item( "NOSCORES"  ) = True
  2571. 		EnableWinSATScores
  2572.  
  2573. 		On Error Goto 0
  2574.  
  2575. 		gvsHeader = "Computer:" & vbTab & "WinPE"
  2576. 		gvsCSVTxt = gvsComputer & vbTab & CStr( gvbWinPE )
  2577.  
  2578.  
  2579. 		InventoryWinSATScores
  2580. 		InventoryCPU
  2581. 		InventoryMemory
  2582. 		InventoryFDD
  2583. 		InventoryHDD
  2584. 		InventoryCDROM
  2585. 		InventoryVideo
  2586. 		InventoryMonitor
  2587. 		InventorySound
  2588. 		InventoryNIC
  2589. 		InventoryMainBoard
  2590. 		InventoryKeyboard
  2591. 		InventoryMouse
  2592. 		InventoryPorts
  2593. 		InventoryBIOS
  2594.  
  2595. 		If CheckboxVideo.Checked Then
  2596. 			If gvaSettingsBool.Item( "DXDIAG" ) Then
  2597. 				blnSuccess = InventoryDirectX( )
  2598. 				If Not blnSuccess Then MsgBox "There was an error reading the DirectX data:" & vbCrLf & "Unable to load """ & gvaSettingsStr.Item( "XML" ) & """", vbOKOnly, "XML error"
  2599. 			End If
  2600. 			Add2CsvVideo
  2601. 		End If
  2602.  
  2603. 		If gvaSettingsBool.Item( "DEVTEST" ) Then
  2604. 			ComputerName.value = "MYPC"
  2605. 			InputDxDiag.value  = "C:\Scripts\Hardware.xml"
  2606. 		Else
  2607. 			ComputerName.value = gvsComputer
  2608. 		End If
  2609.  
  2610. 		' Write the inventory data to the hidden area named "PrintScreen".
  2611. 		' This allows printing with Ctrl+P instead of the Print button.
  2612. 		PrintScreen.innerHTML = PrintTable( )
  2613.  
  2614. 		Set colItems = document.getElementsByTagName( "input" )
  2615. 		For Each objItem In colItems
  2616. 			If objItem.type = "text" Then
  2617. 				objItem.title = objItem.value
  2618. 			End If
  2619. 		Next
  2620. 		Set colItems = Nothing
  2621.  
  2622. 		ButtonCopy.disabled  = False
  2623. 		ButtonPrint.disabled = False
  2624. 		ButtonSave.disabled  = False
  2625. 		ButtonRun.disabled   = False
  2626. 		ButtonSave.Focus( )
  2627. 	End If
  2628.  
  2629. 	DebugMessage "", "End of inventory"
  2630. End Sub
  2631.  
  2632.  
  2633. Sub InventoryBIOS( )
  2634. 	Dim colItems, objItem, objMatches, objRE
  2635. 	Dim strBIOSDate, strBIOSVersion
  2636.  
  2637. 	On Error Resume Next ' REQUIRED
  2638.  
  2639. 	If CheckBoxBIOS.Checked Then
  2640. 		Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_BIOS WHERE PrimaryBIOS = True" )
  2641. 		If Not Err Then
  2642. 			For Each objItem In colItems
  2643. 				strBIOSVersion = objItem.SMBIOSBIOSVersion
  2644. 				strBIOSDate    = Mid( objItem.ReleaseDate, 5, 2 ) & "/" & Mid( objItem.ReleaseDate, 7, 2 ) & "/" & Left( objItem.ReleaseDate, 4 )
  2645. 				gvsBIOSSerial  = objItem.SerialNumber
  2646. 				If InStr( strBIOSVersion, ":" ) Then ' Convert 01:23:00 to 1.23.00
  2647. 					Set objRE = New RegExp
  2648. 					objRE.Pattern = "^\d+(:\d+)+$"
  2649. 					If objRE.Test( strBIOSVersion ) Then
  2650. 						strBIOSVersion = Replace( strBIOSVersion, ":", "." )
  2651. 						If Len( strBIOSVersion ) > 3 Then
  2652. 							If Left( strBIOSVersion, 1 ) = "0" And Not Left( strBIOSVersion, 2 ) = "0." Then
  2653. 								strBIOSVersion = Mid( strBIOSVersion, 2 )
  2654. 							End If
  2655. 						End If
  2656. 					End If
  2657. 				End If
  2658. 				If gvaSettingsBool.Item( "DEVTEST" ) Then strBIOSVersion = gvoRandom.Next_2( 1, 9 ) & "." & gvoRandom.Next_2( 0, 9 ) & gvoRandom.Next_2( 0, 9 )
  2659. 				BIOSManufacturer.value = objItem.Manufacturer
  2660. 				BIOSModel.value        = objItem.Name
  2661. 				BIOSVersion.value      = strBIOSVersion
  2662. 				BIOSDate.value         = strBIOSDate
  2663.  
  2664. 				ButtonDetailsBIOS.disabled = False
  2665. 			Next
  2666. 		End If
  2667.  
  2668. 		DebugMessage "", "BIOS inventory succeeded: " & CStr( Not ButtonDetailsBIOS.disabled )
  2669.  
  2670. 		Add2CsvBIOS
  2671. 	End If
  2672.  
  2673. 	On Error Goto 0
  2674. End Sub
  2675.  
  2676.  
  2677. Sub InventoryCDROM( )
  2678. 	Dim arrDeviceID, arrHardwareID, arrFirmware
  2679. 	Dim i, intIndex, intRow
  2680. 	Dim colItems, objCDROMFirmwares, objCDROMInterfaces, objCDROMModels, objCell, objItem, objTable, objTableRow
  2681. 	Dim strDeviceID, strDriveLetter, strElement, strFirmware, strInterface
  2682.  
  2683. 	If CheckboxCDROM.Checked Then
  2684. 		On Error Resume Next ' REQUIRED
  2685. 		' Find all CDROM drives without the word "virtual" in their name
  2686. 		Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_CDROMDrive WHERE NOT Name LIKE '%Virtual%'" )
  2687. 		If Err Or IsNull( colItems ) Or colItems.Count = 0 Then
  2688. 			On Error Goto 0
  2689. 			If gvbWinPE And gvsWinDrive <> "" Then InventoryCDROMWinPE
  2690. 		Else
  2691. 			Set objCDROMFirmwares  = CreateObject( "System.Collections.Sortedlist" )
  2692. 			Set objCDROMInterfaces = CreateObject( "System.Collections.Sortedlist" )
  2693. 			Set objCDROMModels     = CreateObject( "System.Collections.Sortedlist" )
  2694. 			For Each objItem In colItems
  2695. 				' Use drive letter without colon as key for CDROM SortedLists
  2696. 				strDriveLetter = Left( objItem.Drive, 1 )
  2697. 				' Parse the PNP Device ID string to get the interface and firmware revision
  2698. 				' Example:
  2699. 				' IDE\CDROM_NEC_DVD_RW_ND-3520AW___________________3.05____\5&2E27B08F&0&0.0.0
  2700. 				' ===  <-  interface                               ====  <-  firmware revision
  2701. 				' The array arrDeviceID will contain 3 elements: "IDE",
  2702. 				' "CDROM_NEC_DVD_RW_ND-3520AW___________________3.05____" and "5&2E27B08F&0&0.0.0"
  2703. 				If InStr( objItem.DeviceID, "\" ) Then
  2704. 					arrDeviceID  = Split( Replace( objItem.DeviceID, "&amp;", "&" ), "\", 3, vbTextCompare )
  2705. 					strInterface = arrDeviceID(0)
  2706. 					strDeviceID  = arrDeviceID(1)
  2707. 					' In our example, strDeviceID will contain "CDROM_NEC_DVD_RW_ND-3520AW___________________3.05____"
  2708. 					' The array arrFirmware will contain the elements "CDROM", "NEC", "DVD", "RW", "ND-3520AW", "3.05" and ""
  2709. 					' strFirmware is assigned the value of the last non-empty element in the array
  2710. 					If InStr( strDeviceID, "_" ) Then
  2711. 						arrFirmware  = Split( strDeviceID, "_", -1, vbTextCompare )
  2712. 						If Left( strInterface, 3 ) = "USB" Then strInterface = "USB"
  2713. 						For Each strElement In arrFirmware
  2714. 							If CStr( strElement ) <> "" Then strFirmware = strElement
  2715. 						Next
  2716. 					End If
  2717. 					If gvaSettingsBool.Item( "DEVTEST" ) Then strFirmware = gvoRandom.Next_2( 1, 9 ) & "." & gvoRandom.Next_2( 0, 9 ) & gvoRandom.Next_2( 0, 9 )
  2718. 					objCDROMModels.Item( strDriveLetter )     = objItem.Name
  2719. 					objCDROMInterfaces.Item( strDriveLetter ) = strInterface
  2720. 					objCDROMFirmwares.Item( strDriveLetter )  = strFirmware
  2721. 				End If
  2722. 			Next
  2723.  
  2724.  
  2725. 			Set objTable = document.getElementById( "Results" )
  2726. 			intRow = document.getElementById( "CDROM0" ).rowIndex
  2727. 			CDROM0Index.value     = objCDROMModels.GetKey( 0 ) & ":"
  2728. 			CDROM0Model.value     = objCDROMModels.GetByIndex( 0 )
  2729. 			CDROM0Firmware.value  = objCDROMFirmwares.GetByIndex( 0 )
  2730. 			CDROM0Interface.value = objCDROMInterfaces.GetByIndex( 0 )
  2731.  
  2732. 			If objCDROMModels.Count > 1 Then
  2733. 				document.getElementById( "MultipleCDROMs" ).style.display = "inline"
  2734. 				For i = 1 To objCDROMModels.Count - 1
  2735. 					Set objTableRow   = objTable.insertRow( intRow + i )
  2736. 					objTableRow.id    = "CDROM" & i
  2737.  
  2738. 					Set objCell       = objTableRow.insertCell( 0 )
  2739. 					objCell.innerHTML = "&nbsp;"
  2740.  
  2741. 					Set objCell       = objTableRow.insertCell( 1 )
  2742. 					objCell.innerHTML = "&nbsp;"
  2743.  
  2744. 					Set objCell       = objTableRow.insertCell( 2 )
  2745. 					objCell.innerHTML = "&nbsp;"
  2746.  
  2747. 					Set objCell       = objTableRow.insertCell( 3 )
  2748. 					objCell.innerHTML = "&nbsp;"
  2749.  
  2750. 					Set objCell       = objTableRow.insertCell( 4 )
  2751. 					objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""CDROM" & i & "Index"" size=""12"" value=""" & objCDROMModels.GetKey( i ) & ":"" readonly />"
  2752.  
  2753. 					Set objCell       = objTableRow.insertCell( 5 )
  2754. 					objCell.innerHTML = "&nbsp;"
  2755.  
  2756. 					Set objCell       = objTableRow.insertCell( 6 )
  2757. 					objCell.setAttribute "colSpan", 3
  2758. 					objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""CDROM" & i & "Model"" size=""40"" value=""" & objCDROMModels.GetByIndex( i ) & """ readonly />"
  2759.  
  2760. 					Set objCell       = objTableRow.insertCell( 7 )
  2761. 					objCell.innerHTML = "&nbsp;"
  2762.  
  2763. 					Set objCell       = objTableRow.insertCell( 8 )
  2764. 					objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""CDROM" & i & "Firmware"" size=""16"" value=""" & objCDROMFirmwares.GetByIndex( i ) & """ readonly />"
  2765.  
  2766. 					Set objCell       = objTableRow.insertCell( 9 )
  2767. 					objCell.innerHTML = "&nbsp;"
  2768.  
  2769. 					Set objCell       = objTableRow.insertCell( 10 )
  2770. 					objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""CDROM" & i & "Interface"" size=""16"" value=""" & objCDROMInterfaces.GetByIndex( i ) & """ readonly />"
  2771.  
  2772. 					Set objCell      = Nothing
  2773. 					Set objTableRow  = Nothing
  2774. 				Next
  2775. 			End If
  2776.  
  2777. 			ButtonDetailsCDROM.disabled = ( objCDROMModels.Count = 0 )
  2778.  
  2779. 			DebugMessage "", "CDROM inventory succeeded: " & CStr( Not ButtonDetailsCDROM.disabled )
  2780.  
  2781. 			Set objTable           = Nothing
  2782. 			Set objCDROMModels     = Nothing
  2783. 			Set objCDROMFirmwares  = Nothing
  2784. 			Set objCDROMInterfaces = Nothing
  2785.  
  2786. 			On Error Goto 0
  2787.  
  2788. 			Add2CsvCDROM
  2789. 		End If
  2790. 	End If
  2791. End Sub
  2792.  
  2793.  
  2794. Sub InventoryCDROMWinPE( )
  2795. 	Dim arrHardwareID, arrRegKeys, arrSubKeys, arrTest
  2796. 	Dim dicDescriptions, dicFirmware, dicHardwareIDs, dicInterfaces
  2797. 	Dim colItems, objItem, objRE, objReg
  2798. 	Dim i, intIndex, j
  2799. 	Dim strDescription, strDictKey, strRegKey, strRegSubKey, strWMIQuery
  2800.  
  2801. 	Set dicDescriptions = CreateObject( "Scripting.Dictionary" )
  2802. 	Set dicFirmware     = CreateObject( "Scripting.Dictionary" )
  2803. 	Set dicHardwareIDs  = CreateObject( "Scripting.Dictionary" )
  2804. 	Set dicInterfaces   = CreateObject( "Scripting.Dictionary" )
  2805. 	Set objRE           = New RegExp
  2806.  
  2807. 	' Mount registry hive from Windows Drive
  2808. 	gvoWSHShell.Run "CMD.EXE /C REG.EXE Load HKLM\TempHive " & gvsWinDrive & "\windows\system32\config\system", 0, True
  2809.  
  2810. 	' Scan the temporary registry hive for IDE CDROM devices
  2811. 	strWMIQuery = "winmgmts:{impersonationLevel=impersonate}!//./root/default:StdRegProv"
  2812. 	Set objReg = GetObject( strWMIQuery )
  2813. 	objReg.EnumKey HKEY_LOCAL_MACHINE, "TempHive\ControlSet001\Enum\IDE", arrRegKeys
  2814. 	If Not IsNull( arrRegKeys ) Then
  2815. 		For i = 0 To UBound( arrRegKeys )
  2816. 			strRegKey = arrRegKeys(i)
  2817. 			If Left( UCase( strRegKey ), 5 ) = "CDROM" Then
  2818. 				objReg.EnumKey HKEY_LOCAL_MACHINE, "TempHive\ControlSet001\Enum\IDE\" & strRegKey, arrSubKeys
  2819. 				For Each strRegSubKey In arrSubKeys
  2820. 					objReg.GetMultiStringValue HKEY_LOCAL_MACHINE, "TempHive\ControlSet001\Enum\IDE\" & strRegKey & "\" & strRegSubKey, "HardwareID", arrHardwareID
  2821. 					If Not IsNull( arrHardwareID ) Then
  2822. 						If InStr( UCase( arrHardwareID(0) ), "VIRTUAL" ) = 0 Then
  2823. 							If Left( UCase( arrHardwareID(0) ), 4 ) = "IDE\"  Then arrHardwareID(0) = Mid( arrHardwareID(0), 5 )
  2824. 							If Left( UCase( arrHardwareID(0) ), 5 ) = "CDROM" Then arrHardwareID(0) = Mid( arrHardwareID(0), 6 )
  2825. 							objReg.GetStringValue HKEY_LOCAL_MACHINE, "TempHive\ControlSet001\Enum\IDE\" & strRegKey & "\" & strRegSubKey, "FriendlyName", strDescription
  2826. 							strDictKey = objRE.Replace( arrHardwareID(0), "" )
  2827. 							dicHardwareIDs.Item( strDictKey )  = arrHardwareID(0)
  2828. 							dicDescriptions.Item( strDictKey ) = strDescription
  2829. 							dicInterfaces.Item( strDictKey )   = "IDE"
  2830. 							arrTest = Split( arrHardwareID(0), "_" )
  2831. 							For j = 0 To UBound( arrTest )
  2832. 								If Not arrTest(i) = "" Then
  2833. 									dicFirmware.Item( strDictKey ) = arrTest(j)
  2834. 								End If
  2835. 							Next
  2836. 						End If
  2837. 						arrHardwareID = Null
  2838. 					End If
  2839. 				Next
  2840. 				arrSubKeys = Null
  2841. 			End If
  2842. 		Next
  2843. 		arrRegKeys = Null
  2844. 	End If
  2845.  
  2846. 	' Scan the temporary registry hive for SCSI CDROM devices
  2847. 	objReg.EnumKey HKEY_LOCAL_MACHINE, "TempHive\ControlSet001\Enum\SCSI", arrRegKeys
  2848. 	If Not IsNull( arrRegKeys ) Then
  2849. 		For Each strRegKey In arrRegKeys
  2850. 			If Left( UCase( strRegKey ), 5 ) = "CDROM" Then
  2851. 				objReg.EnumKey HKEY_LOCAL_MACHINE, "TempHive\ControlSet001\Enum\SCSI\" & strRegKey, arrSubKeys
  2852. 				For Each strRegSubKey In arrSubKeys
  2853. 					objReg.GetMultiStringValue HKEY_LOCAL_MACHINE, "TempHive\ControlSet001\Enum\SCSI\" & strRegKey & "\" & strRegSubKey, "HardwareID", arrHardwareID
  2854. 					If Not IsNull( arrHardwareID ) Then
  2855. 						If InStr( UCase( arrHardwareID(0) ), "VIRTUAL" ) = 0 Then
  2856. 							If Left( UCase( arrHardwareID(0) ), 5 ) = "SCSI\" Then arrHardwareID(0) = Mid( arrHardwareID(0), 6 )
  2857. 							If Left( UCase( arrHardwareID(0) ), 5 ) = "CDROM" Then arrHardwareID(0) = Mid( arrHardwareID(0), 6 )
  2858. 							objReg.GetStringValue HKEY_LOCAL_MACHINE, "TempHive\ControlSet001\Enum\SCSI\" & strRegKey & "\" & strRegSubKey, "FriendlyName", strDescription
  2859. 							strDictKey = objRE.Replace( arrHardwareID(0), "" )
  2860. 							dicHardwareIDs.Item( strDictKey )  = arrHardwareID(0)
  2861. 							dicDescriptions.Item( strDictKey ) = strDescription
  2862. 							dicInterfaces.Item( strDictKey )   = "SCSI"
  2863. 							arrTest = Split( arrHardwareID(0), "_" )
  2864. 							For i = 0 To UBound( arrTest )
  2865. 								If Not arrTest(i) = "" Then
  2866. 									dicFirmware.Item( strDictKey ) = arrTest(i)
  2867. 								End If
  2868. 							Next
  2869. 						End If
  2870. 						arrHardwareID = Null
  2871. 					End If
  2872. 				Next
  2873. 				arrSubKeys = Null
  2874. 			End If
  2875. 		Next
  2876. 		arrRegKeys = Null
  2877. 	End If
  2878.  
  2879. 	' Show the results
  2880. 	If dicHardwareIDs.Count > 0 Then
  2881. 		CDROM0Index.value     = dicDescriptions.Keys(0)
  2882. 		CDROM0Model.value     = dicDescriptions(0)
  2883. 		CDROM0Firmware.value  = dicFirmware(0)
  2884. 		CDROM0Interface.value = dicInterfaces(0)
  2885.  
  2886. 		If objCDROMModels.Count > 1 Then
  2887. 			MultipleCDROMs.style.display = "inline"
  2888. 			Set objTable = document.getElementById( "Results" )
  2889. 			intRow = document.getElementById( "CDROM0" ).rowIndex
  2890. 			For i = 1 To objCDROMModels.Count - 1
  2891. 				Set objTableRow   = objTable.insertRow( intRow + i )
  2892. 				objTableRow.id    = "CDROM" & i
  2893. 				Set objCell       = objTableRow.insertCell( 0 )
  2894. 				objCell.innerHTML = "&nbsp;"
  2895. 				Set objCell       = objTableRow.insertCell( 1 )
  2896. 				objCell.innerHTML = "&nbsp;"
  2897. 				Set objCell       = objTableRow.insertCell( 2 )
  2898. 				objCell.innerHTML = "&nbsp;"
  2899. 				Set objCell       = objTableRow.insertCell( 3 )
  2900. 				objCell.innerHTML = "&nbsp;"
  2901. 				Set objCell       = objTableRow.insertCell( 4 )
  2902. 				objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""CDROM" & i & "Index"" size=""12"" value=""" & dicDescriptions.Keys(i) & ":"" readonly />"
  2903. 				Set objCell       = objTableRow.insertCell( 5 )
  2904. 				objCell.innerHTML = "&nbsp;"
  2905. 				Set objCell       = objTableRow.insertCell( 6 )
  2906. 				objcell.setAttribute "colSpan", 3
  2907. 				objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""CDROM" & i & "Model"" size=""40"" value=""" & dicDescriptions(i) & """ readonly />"
  2908. 				Set objCell       = objTableRow.insertCell( 7 )
  2909. 				objCell.innerHTML = "&nbsp;"
  2910. 				Set objCell       = objTableRow.insertCell( 8 )
  2911. 				objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""CDROM" & i & "Firmware"" size=""16"" value=""" & dicFirmware(i) & """ readonly />"
  2912. 				Set objCell       = objTableRow.insertCell( 9 )
  2913. 				objCell.innerHTML = "&nbsp;"
  2914. 				Set objCell       = objTableRow.insertCell( 10 )
  2915. 				objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""CDROM" & i & "Interface"" size=""16"" value=""" & dicInterfaces(i) & """ readonly />"
  2916. 				Set objCell      = Nothing
  2917. 				Set objTableRow  = Nothing
  2918. 			Next
  2919. 			Set objTable = Nothing
  2920. 		End If
  2921. 	End If
  2922.  
  2923. 	DebugMessage "", "CDROM inventory succeeded: " & CStr( Not ButtonDetailsCDROM.disabled )
  2924.  
  2925. 	' Unmount temporary registry hive
  2926. 	gvoWSHShell.Run "CMD.EXE /C REG.EXE Unload HKLM\TempHive", 0, True
  2927. 	Set dicDescriptions = Nothing
  2928. 	Set dicFirmware     = Nothing
  2929. 	Set dicHardwareIDs  = Nothing
  2930. 	Set dicInterfaces   = Nothing
  2931. 	Set objRE           = Nothing
  2932.  
  2933. 	Add2CsvCDROM
  2934. End Sub
  2935.  
  2936.  
  2937. Sub InventoryCPU( )
  2938. 	Dim colItems, objItem
  2939.  
  2940. 	If CheckBoxCPU.Checked Then
  2941. 		On Error Resume Next ' REQUIRED
  2942.  
  2943. 		Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_Processor" )
  2944. 		If Not Err Then
  2945. 			gvcCPU = colItems.Count
  2946. 			CPUNumber.value = gvcCPU
  2947. 			If gvcCPU > 1 Then MultipleCPU.InnerHTML  = "s"
  2948. 			For Each objItem In colItems
  2949. 				CPUModel.value  = Trim( objItem.Name )
  2950. 				CPUSpeed.value  = objItem.CurrentClockSpeed
  2951. 				CPUSocket.value = objItem.SocketDesignation
  2952. 			Next
  2953. 			ButtonDetailsCPU.disabled = False
  2954. 		End If
  2955.  
  2956. 		On Error Goto 0
  2957.  
  2958. 		DebugMessage "", "CPU inventory succeeded: " & CStr( Not ButtonDetailsCPU.disabled )
  2959.  
  2960. 		Add2CsvCPU
  2961. 	End If
  2962. End Sub
  2963.  
  2964.  
  2965. Function InventoryDirectX( )
  2966. 	Dim blnLoaded, i
  2967. 	Dim colItems, colNodes, objItem, objNode, xmlDoc
  2968. 	Dim strDxDiag, strQuery, strSysDir
  2969.  
  2970. 	strSysDir = gvoWSHShell.ExpandEnvironmentStrings( "%Windir%\System32" )
  2971. 	strDxDiag = gvoFSO.BuildPath( strSysDir, "DxDiag.exe" )
  2972.  
  2973. 	' Delete old XML file if it exists, unless specified otherwise
  2974. 	If Not gvaSettingsBool.Item( "KEEPXML" ) Then
  2975. 		If gvoFSO.FileExists( gvaSettingsStr.Item( "XML" ) ) Then gvoFSO.DeleteFile gvaSettingsStr.Item( "XML" ), True
  2976. 	End If
  2977.  
  2978. 	' Run DXDIAG.EXE, if required, and save results in XML file
  2979. 	If gvoFSO.FileExists( gvaSettingsStr.Item( "XML" ) ) Then
  2980. 		If Not gvaSettingsBool.Item( "KEEPXML" ) Then
  2981. 			gvoFSO.DeleteFile gvaSettingsStr.Item( "XML" ), True
  2982. 			Sleep 2
  2983. 			gvoWSHShell.Run strDxDiag & " /whql:off /x " & gvaSettingsStr.Item( "XML" ), 7, False
  2984. 		End If
  2985. 	Else
  2986. 		gvoWSHShell.Run strDxDiag & " /whql:off /x " & gvaSettingsStr.Item( "XML" ), 7, False
  2987. 	End If
  2988.  
  2989. 	' Wait until XML file is created, 5 minutes maximum
  2990. 	For i = 1 To 150
  2991. 		Sleep 1
  2992. 		If gvoFSO.FileExists( gvaSettingsStr.Item( "XML" ) ) Then Exit For
  2993. 		Sleep 1
  2994. 	Next
  2995.  
  2996. 	' Wait for DXDIAG to close, 30 seconds maximum
  2997. 	Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_Process WHERE Caption='DxDiag.exe'" )
  2998. 	For i = 1 To 5
  2999. 		If colItems.count = 0 Then Exit For
  3000. 		Sleep 6
  3001. 		Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_Process WHERE Caption='DxDiag.exe'" )
  3002. 	Next
  3003.  
  3004. 	' Open the XML file created by DXDIAG
  3005. 	Set xmlDoc = CreateObject( "Microsoft.XMLDOM" )
  3006. 	xmlDoc.Async = "False"
  3007. 	blnLoaded = xmlDoc.Load( gvaSettingsStr.Item( "XML" ) )
  3008. 	If Not blnLoaded Then
  3009. 		' Retry 5 times maximum, with 6 seconds interval
  3010. 		For i = 1 To 15
  3011. 			Sleep 2
  3012. 			blnLoaded = xmlDoc.Load( gvaSettingsStr.Item( "XML" ) )
  3013. 			If blnLoaded Then Exit For
  3014. 		Next
  3015. 		Sleep 2
  3016. 		MsgBox "Process DxDiag.exe still running", vbOKOnly, "DxDiag error"
  3017. 	End If
  3018.  
  3019. 	If blnLoaded Then
  3020. 		ReDim gvaVideo( 4, 0 )
  3021.  
  3022. 		strQuery = "/DxDiag/DisplayDevices/DisplayDevice/DisplayMemory"
  3023. 		Set colNodes = xmlDoc.selectNodes( strQuery )
  3024. 		i = 0
  3025. 		For Each objNode in colNodes
  3026. 			ReDim Preserve gvaVideo( 4, i )
  3027. 			gvaVideo( 0, i ) = Trim( Replace( objNode.text, "MB", "" ) )
  3028. 			i = i + 1
  3029. 		Next
  3030.  
  3031. 		strQuery = "/DxDiag/DisplayDevices/DisplayDevice/CurrentMode"
  3032. 		Set colNodes = xmlDoc.selectNodes( strQuery )
  3033. 		i = 0
  3034. 		For Each objNode in colNodes
  3035. 			gvaVideo( 1, i ) = Trim( objNode.text )
  3036. 			i = i + 1
  3037. 		Next
  3038.  
  3039. 		strQuery = "/DxDiag/DisplayDevices/DisplayDevice/MonitorName"
  3040. 		Set colNodes = xmlDoc.selectNodes( strQuery )
  3041. 		i = 0
  3042. 		For Each objNode in colNodes
  3043. 			gvaVideo( 2, i ) = Trim( objNode.text )
  3044. 			i = i + 1
  3045. 		Next
  3046.  
  3047. 		strQuery = "/DxDiag/DisplayDevices/DisplayDevice/MonitorModel"
  3048. 		Set colNodes = xmlDoc.selectNodes( strQuery )
  3049. 		i = 0
  3050. 		For Each objNode in colNodes
  3051. 			gvaVideo( 3, i ) = Trim( objNode.text )
  3052. 			i = i + 1
  3053. 		Next
  3054.  
  3055. 		strQuery = "/DxDiag/DisplayDevices/DisplayDevice/CardName"
  3056. 		Set colNodes = xmlDoc.selectNodes( strQuery )
  3057. 		i = 0
  3058. 		For Each objNode in colNodes
  3059. 			gvaVideo( 4, i ) = Trim( objNode.text )
  3060. 			i = i + 1
  3061. 		Next
  3062.  
  3063. 		InventoryDirectX = True
  3064. 	Else
  3065. 		InventoryDirectX = False
  3066. 	End If
  3067.  
  3068. 	' Clean up
  3069. 	Set colNodes = Nothing
  3070. 	Set xmlDoc   = Nothing
  3071.  
  3072. 	DebugMessage "", "DirectX inventory succeeded: " & CStr( InventoryDirectX )
  3073. End Function
  3074.  
  3075.  
  3076. Sub InventoryFDD( )
  3077. 	Dim cntAllFloppy, cntIntFloppy, cntUSBFloppy, i, intRow
  3078. 	Dim colItems, colItems2, objCell, objFDDCapacities, objFDDDescriptions, objFDDInterfaces, objItem, objItem2, objRE, objTable, objTableRow
  3079. 	Dim strDriveLetter, strInterface, strQuery
  3080.  
  3081. 	If CheckboxFDD.Checked Then
  3082. 		On Error Resume Next ' REQUIRED
  3083.  
  3084. 		strInterface = "Unknown"
  3085. 		cntAllFloppy = 0
  3086. 		cntIntFloppy = 0
  3087. 		cntUSBFloppy = 0
  3088.  
  3089. 		' Count total number of floppy disk drives
  3090. 		strQuery = "SELECT * FROM Win32_PnPEntity WHERE PNPClass='FloppyDisk'"
  3091. 		Set colItems = gvoWMIrootCimv2.ExecQuery( strQuery )
  3092. 		If Not Err Then cntAllFloppy = colItems.Count
  3093. 		' Count number of USB-attached floppy disk drives
  3094. 		strQuery = "SELECT * FROM Win32_PnPEntity WHERE PNPDeviceID LIKE 'USBSTOR%FLOPPY%'"
  3095. 		Set colItems = gvoWMIrootCimv2.ExecQuery( strQuery )
  3096. 		If Not Err Then cntUSBFloppy = colItems.Count
  3097. 		' Count number of internal floppy drive connectors
  3098. 		strQuery = "SELECT * FROM Win32_PortConnector"
  3099. 		Set colItems = gvoWMIrootCimv2.ExecQuery( strQuery )
  3100. 		If Not Err Then
  3101. 			For Each objItem In colItems
  3102. 				If objItem.PortType <> Null Then
  3103. 					For i = 0 To Len( objItem.PortType ) - 1
  3104. 						If objItem.PortType(i) = 89 Or objItem.PortType(i) = 91 Then
  3105. 							cntIntFloppy = cntIntFloppy + 1
  3106. 						End If
  3107. 					Next
  3108. 				End If
  3109. 			Next
  3110. 		End If
  3111. 		' 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
  3112. 		If cntAllFloppy = cntUSBFloppy Then
  3113. 			strInterface = "USB"
  3114. 		ElseIf cntUSBFloppy = 0 And cntIntFloppy >= cntAllFloppy Then
  3115. 			strInterface = "Flatcable"
  3116. 		End If
  3117. 		' Find all floppy disk drives
  3118. 		strQuery = "SELECT * FROM Win32_LogicalDisk WHERE DriveType=2 AND MediaType IS NOT NULL AND MediaType != 0 AND MediaType != 11 AND MediaType != 12" 
  3119. 		Set colItems = gvoWMIrootCimv2.ExecQuery( strQuery )
  3120. 		If colItems.Count > 0 And Not Err Then
  3121. 			Set objFDDCapacities   = CreateObject( "System.Collections.Sortedlist" )
  3122. 			Set objFDDDescriptions = CreateObject( "System.Collections.Sortedlist" )
  3123. 			Set objFDDInterfaces   = CreateObject( "System.Collections.Sortedlist" )
  3124. 			Set objRE = New RegExp
  3125. 			For Each objItem In colItems
  3126. 				If Trim( "" & objItem.DeviceId ) <> "" Then
  3127. 					strDriveLetter = Left( objItem.DeviceId, 1 )
  3128. 					'Set colItems2 = objWMIService.ExecQuery( "SELECT * FROM MSFT_Volume WHERE DriveLetter=""" & strDriveLetter & """" )
  3129. 					objRE.Pattern    = "[\d\.]+\s*[MK]B$"
  3130. 					objRE.IgnoreCase = True
  3131. 					If objRE.Test( GetMediaType( objItem.MediaType ) ) Then
  3132. 						objFDDCapacities.Item( strDriveLetter ) = objRE.Execute( GetMediaType( objItem.MediaType ) )(0)
  3133. 					Else
  3134. 						objFDDCapacities.Item( strDriveLetter ) = "Unknown"
  3135. 					End If
  3136. 					objFDDDescriptions.Item( strDriveLetter ) = objItem.Description
  3137. 					objFDDInterfaces.Item( strDriveLetter )   = strInterface
  3138. 				End If
  3139. 			Next
  3140.  
  3141. 			FDD0DeviceID.value    = objFDDDescriptions.GetKey( 0 ) & ":"
  3142. 			FDD0Description.value = objFDDDescriptions.GetByIndex( 0 )
  3143. 			FDD0Capacity.value    = objFDDCapacities.GetByIndex( 0 )
  3144. 			FDD0Interface.value   = objFDDInterfaces.GetByIndex( 0 )
  3145.  
  3146. 			If objFDDDescriptions.Count > 1 Then
  3147. 				document.getElementById( "MultipleFDDs" ).style.display = "inline"
  3148. 				Set objTable = document.getElementById( "Results" )
  3149. 				intRow = document.getElementById( "FDD0" ).rowIndex
  3150. 				For i = 1 To objFDDDescriptions.Count - 1
  3151. 					Set objTableRow   = objTable.insertRow( intRow + i )
  3152. 					objTableRow.id    = "FDD" & i
  3153. 					Set objCell       = objTableRow.insertCell( 0 )
  3154. 					objCell.innerHTML = "&nbsp;"
  3155. 					Set objCell       = objTableRow.insertCell( 1 )
  3156. 					objCell.innerHTML = "&nbsp;"
  3157. 					Set objCell       = objTableRow.insertCell( 2 )
  3158. 					objCell.innerHTML = "&nbsp;"
  3159. 					Set objCell       = objTableRow.insertCell( 3 )
  3160. 					objCell.innerHTML = "&nbsp;"
  3161. 					Set objCell       = objTableRow.insertCell( 4 )
  3162. 					objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""FDD" & i & "DeviceID"" size=""12"" value=""" & objFDDDescriptions.GetKey( i ) & ":"" readonly />"
  3163. 					Set objCell       = objTableRow.insertCell( 5 )
  3164. 					objCell.innerHTML = "&nbsp;"
  3165. 					Set objCell       = objTableRow.insertCell( 6 )
  3166. 					objcell.setAttribute "colSpan", 3
  3167. 					objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""FDD" & i & "Description"" size=""40"" value=""" & objFDDDescriptions.GetByIndex( i ) & """ readonly />"
  3168. 					Set objCell       = objTableRow.insertCell( 7 )
  3169. 					objCell.innerHTML = "&nbsp;"
  3170. 					Set objCell       = objTableRow.insertCell( 8 )
  3171. 					objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""FDD" & i & "Capacity"" size=""16"" value=""" & objFDDCapacities.GetByIndex( i ) & """ readonly />"
  3172. 					Set objCell       = objTableRow.insertCell( 9 )
  3173. 					objCell.innerHTML = "&nbsp;"
  3174. 					Set objCell       = objTableRow.insertCell( 10 )
  3175. 					objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""FDD" & i & "Interface"" size=""16"" value=""" & objFDDInterfaces.GetByIndex( i ) & """ readonly />"
  3176. 					Set objCell       = Nothing
  3177. 					Set objTableRow   = Nothing
  3178. 				Next
  3179. 				Set objTable = Nothing
  3180. 			End If
  3181.  
  3182. 			Set objFDDDescriptions = Nothing
  3183. 			Set objFDDInterfaces   = Nothing
  3184.  
  3185. 			ButtonDetailsFDD.disabled = False
  3186. 		End If
  3187.  
  3188. 		On Error GoTo 0
  3189.  
  3190. 		DebugMessage "", "FDD inventory succeeded: " & CStr( Not ButtonDetailsFDD.disabled )
  3191.  
  3192. 		Add2CsvFDD
  3193. 	End If
  3194. End Sub
  3195.  
  3196.  
  3197. Sub InventoryHDD( )
  3198. 	Dim i, intRow
  3199. 	Dim colItems, objCell, objHDDInterfaces, objHDDModels, objHDDSizes, objItem, objTable, objTableRow
  3200. 	Dim strQuery
  3201.  
  3202. 	If CheckboxHDD.Checked Then
  3203. 		On Error Resume Next ' REQUIRED
  3204.  
  3205. 		strQuery = "SELECT * FROM MSFT_PhysicalDisk"
  3206. 		Set colItems = gvoWMIrootMSWinStorage.ExecQuery( strQuery )
  3207. 		If Not Err Then
  3208. 			' Using SortedList instead of array because there may be "gaps" in the list of disk indexes
  3209. 			Set objHDDInterfaces = CreateObject( "System.Collections.Sortedlist" )
  3210. 			Set objHDDModels     = CreateObject( "System.Collections.Sortedlist" )
  3211. 			Set objHDDSizes      = CreateObject( "System.Collections.Sortedlist" )
  3212. 			For Each objItem In colItems
  3213. 				If gvaSettingsBool.Item( "USBSTOR" ) Or Not GetBusType( objItem.BusType ) = "USB" Then
  3214. 					If gvaSettingsBool.Item( "VIRTUAL" ) Or InStr( LCase( objItem.FriendlyName ), "virtual" ) = 0 Then
  3215. 						objHDDModels.Item( CInt( objItem.DeviceID ) )     = objItem.FriendlyName
  3216. 						objHDDSizes.Item( CInt( objItem.DeviceID ) )      = Round( objItem.Size / GB )
  3217. 						objHDDInterfaces.Item( CInt( objItem.DeviceID ) ) = GetBusType( objItem.BusType )
  3218. 					End If
  3219. 				End If
  3220. 			Next
  3221.  
  3222. 			HardDisk0Index.value     = objHDDModels.GetKey( 0 ) & ":"
  3223. 			HardDisk0Model.value     = objHDDModels.GetByIndex( 0 )
  3224. 			HardDisk0Size.value      = objHDDSizes.GetByIndex( 0 )
  3225. 			HardDisk0Interface.value = objHDDInterfaces.GetByIndex( 0 )
  3226. 			ButtonDetailsHDD.disabled = False
  3227.  
  3228. 			If objHDDModels.Count > 1 Then
  3229. 				document.getElementById( "MultipleHDUs" ).style.display = "inline"
  3230. 				Set objTable = document.getElementById( "Results" )
  3231. 				intRow = document.getElementById( "HardDisk0" ).rowIndex
  3232. 				For i = 1 To objHDDModels.Count - 1
  3233. 					Set objTableRow   = objTable.insertRow( intRow + i )
  3234. 					objTableRow.id    = "HardDisk" & i
  3235. 					Set objCell       = objTableRow.insertCell( 0 )
  3236. 					objCell.innerHTML = "&nbsp;"
  3237. 					Set objCell       = objTableRow.insertCell( 1 )
  3238. 					objCell.innerHTML = "&nbsp;"
  3239. 					Set objCell       = objTableRow.insertCell( 2 )
  3240. 					objCell.innerHTML = "&nbsp;"
  3241. 					Set objCell       = objTableRow.insertCell( 3 )
  3242. 					objCell.innerHTML = "&nbsp;"
  3243. 					Set objCell       = objTableRow.insertCell( 4 )
  3244. 					objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""HardDisk" & i & "Index"" size=""12"" value=""" & objHDDModels.GetKey( i ) & """ readonly />"
  3245. 					Set objCell       = objTableRow.insertCell( 5 )
  3246. 					objCell.innerHTML = "&nbsp;"
  3247. 					Set objCell       = objTableRow.insertCell( 6 )
  3248. 					objCell.setAttribute "colSpan", 3
  3249. 					objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""HardDisk" & i & "Model"" size=""40"" value=""" & objHDDModels.GetByIndex( i ) & """ readonly />"
  3250. 					Set objCell       = objTableRow.insertCell( 7 )
  3251. 					objCell.innerHTML = "&nbsp;"
  3252. 					Set objCell       = objTableRow.insertCell( 8 )
  3253. 					objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""HardDisk" & i & "Size"" size=""16"" value=""" & objHDDSizes.GetByIndex( i ) & """ readonly />"
  3254. 					Set objCell       = objTableRow.insertCell( 9 )
  3255. 					objCell.innerHTML = "&nbsp;"
  3256. 					Set objCell       = objTableRow.insertCell( 10 )
  3257. 					objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""HardDisk" & i & "Interface"" size=""16"" value=""" & objHDDInterfaces.GetByIndex( i ) & """ readonly />"
  3258. 					Set objCell       = Nothing
  3259. 					Set objTableRow   = Nothing
  3260. 				Next
  3261. 				Set objTable = Nothing
  3262. 			End If
  3263.  
  3264. 			Set objHDDInterfaces = Nothing
  3265. 			Set objHDDModels     = Nothing
  3266. 			Set objHDDSizes      = Nothing
  3267. 		End If
  3268.  
  3269. 		On Error Goto 0
  3270.  
  3271. 		DebugMessage "", "HDD inventory succeeded: " & CStr( Not ButtonDetailsHDD.disabled )
  3272.  
  3273. 		Add2CsvHDD
  3274. 	End If
  3275. End Sub
  3276.  
  3277.  
  3278. Sub InventoryKeyboard( )
  3279. 	Dim arrConnectorTypes, arrHardwareTypes
  3280. 	Dim blnHideFkeys
  3281. 	Dim intButtons, intConnectorType, intCount, intFkeys, intLEDs
  3282. 	Dim colItems, objItem
  3283. 	Dim strConnectorType, strKbdPNP, strMouseModel, strMouseType
  3284.  
  3285. 	If CheckboxKeyboard.checked Then
  3286. 		' Enumeration of connector and hardware types
  3287. 		arrConnectorTypes = Array( "I8042", "Serial", "USB" )
  3288. 		ReDim Preserve arrDeviceInterfaces( 162 )
  3289. 		arrDeviceInterfaces( 160 ) = "Bus mouse DB-9"
  3290. 		arrDeviceInterfaces( 161 ) = "Bus mouse micro-DIN"
  3291. 		arrDeviceInterfaces( 162 ) = "USB"
  3292.  
  3293. 		On Error Resume Next ' REQUIRED
  3294.  
  3295. 		blnHideFkeys = Not gvbIsElevated
  3296.  
  3297. 		' Check for keyboard details in root/WMI - this may fail on access denied errors when not running with elevated privileges
  3298. 		intCount  = 0
  3299. 		strKbdPNP = ""
  3300. 		Set colItems = gvoWMIrootWMI.ExecQuery( "SELECT * FROM MSKeyboard_PortInformation WHERE Active = True" )
  3301. 		If Not Err Then
  3302. 			intCount = colItems.Count
  3303. 			If intCount > 1 Then
  3304. 				Set colItems = gvoWMIrootWMI.ExecQuery( "SELECT * FROM MSKeyboard_PortInformation WHERE Active = True AND Instancename LIKE 'HID\\%'" )
  3305. 				intCount = colItems.Count
  3306. 				If colItems.Count = 0 Then
  3307. 					Set colItems = gvoWMIrootWMI.ExecQuery( "SELECT * FROM MSKeyboard_PortInformation WHERE Active = True AND Instancename LIKE '%&%'" )
  3308. 				End If
  3309. 			End If
  3310. 			For Each objItem In colItems
  3311. 				intFkeys  = 0
  3312. 				intLEDs   = 0
  3313. 				strKbdPNP = Split( objItem.InstanceName, "\" )(1)
  3314. 				intFkeys  = objItem.FunctionKeys
  3315. 				intLEDs   = objItem.Indicators
  3316. 				KeyboardFkLEDs.value = intFkeys & " F-keys; " & intLEDs & " LEDs"
  3317. 				intConnectorType = objItem.ConnectorType
  3318. 				If Not IsEmpty( intConnectorType ) Then
  3319. 					strConnectorType = arrConnectorTypes( intConnectorType )
  3320. 					KeyboardConnector.value = strConnectorType
  3321. 				End If
  3322. 				blnHideFkeys = ( intFkeys = 0 And intLEDs = 0 )
  3323. 			Next
  3324. 			ButtonDetailsKeyboard.disabled = False
  3325. 		End If
  3326.  
  3327. 		If strKbdPNP = "" Then
  3328. 			' Check for keyboard details in root/CIMV2 - this is less likely to fail on access denied errors
  3329. 			intCount = 0
  3330. 			Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_Keyboard" )
  3331. 			If Not Err Then
  3332. 				intCount = colItems.Count
  3333. 				If intCount > 1 Then
  3334. 					Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_Keyboard WHERE NOT PNPDeviceID LIKE 'ACPI\\%'" )
  3335. 					intCount = colItems.Count
  3336. 					If colItems.Count = 0 Then
  3337. 						Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_Keyboard" )
  3338. 					End If
  3339. 				End If
  3340. 				For Each objItem In colItems
  3341. 					If KeyboardModel.value  = "" Then KeyboardModel.value = objItem.Description
  3342. 					If KeyboardType.value   = ""  Then KeyboardType.value  = objItem.Name
  3343. 					If KeyboardFkLEDs.value = "" Then
  3344. 						intFkeys = objItem.NumberOfFunctionkeys
  3345. 						If Not IsEmpty( intFkeys ) And intFkeys > 0 Then KeyboardFkLEDs.value = intFkeys & " F-keys"
  3346. 					End If
  3347. 					KeyboardModel.value = objItem.Description
  3348. 					KeyboardType.value  = objItem.Name
  3349. 					If KeyboardConnector.value = "" Then
  3350. 						strConnectorType = Split( objItem.PNPDeviceID, "\" )(0)
  3351. 						KeyboardConnector.value = strConnectorType
  3352. 					End If
  3353. 				Next
  3354. 				ButtonDetailsKeyboard.disabled = False
  3355. 			End If
  3356. 		Else
  3357. 			Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_Keyboard WHERE PNPDeviceID LIKE '%\\" & strKbdPNP & "\\%'" )
  3358. 			If Not Err Then
  3359. 				For Each objItem In colItems
  3360. 					KeyboardModel.value = objItem.Description
  3361. 					KeyboardType.value  = objItem.Name
  3362. 				Next
  3363. 				ButtonDetailsKeyboard.disabled = False
  3364. 			End If
  3365. 		End If
  3366.  
  3367. 		If blnHideFkeys Then 
  3368. 			' If not running with elevated privileges, this field contains nonsense
  3369. 			KeyboardHeaderFkLEDs.style.visibility = "hidden"
  3370. 			KeyboardFkLEDs.style.visibility       = "hidden"
  3371. 		Else
  3372. 			KeyboardHeaderFkLEDs.style.visibility = "visible"
  3373. 			KeyboardFkLEDs.style.visibility       = "visible"
  3374. 		End if
  3375.  
  3376. 		On Error Goto 0
  3377.  
  3378. 		DebugMessage "", "Keyboard inventory succeeded: " & CStr( Not ButtonDetailsKeyboard.disabled )
  3379.  
  3380. 		Add2CsvKbd
  3381. 	End If
  3382. End Sub
  3383.  
  3384.  
  3385. Sub InventoryMainBoard( )
  3386. 	Dim colItems, objItem, strMBVersion
  3387.  
  3388. 	If CheckboxMainBoard.Checked Then
  3389. 		On Error Resume Next ' REQUIRED
  3390.  
  3391. 		Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_BaseBoard" )
  3392. 		If Not Err Then
  3393. 			For Each objItem In colItems
  3394. 				If gvaSettingsBool.Item( "DEVTEST" ) Then
  3395. 					strMBVersion = gvoRandom.Next_2( 1, 9 ) & "." & gvoRandom.Next_2( 0, 9 ) & gvoRandom.Next_2( 0, 9 )
  3396. 				Else
  3397. 					strMBVersion = objItem.Version
  3398. 				End If
  3399. 				MBManufacturer.value = objItem.Manufacturer
  3400. 				MBModel.value        = objItem.Product
  3401. 				MBVersion.value      = strMBVersion
  3402. 			Next
  3403. 			ButtonDetailsMainBoard.disabled = False
  3404. 		End If
  3405.  
  3406. 		On Error Goto 0
  3407.  
  3408. 		ChassisType.value = GetChassis( )
  3409.  
  3410. 		Add2CsvMainBoard
  3411. 	End If
  3412.  
  3413. 	On Error GoTo 0
  3414.  
  3415. 	DebugMessage "", "Main Board inventory succeeded: " & CStr( Not ButtonDetailsMainBoard.disabled )
  3416. End Sub
  3417.  
  3418.  
  3419. Sub InventoryMemory( )
  3420. 	Dim colItems, objItem
  3421.  
  3422. 	If CheckboxMemory.Checked Then
  3423. 		On Error Resume Next ' REQUIRED
  3424.  
  3425. 		' Capacity filter intended for HP/COMPAQ EVO models
  3426. 		Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_PhysicalMemory WHERE Capacity > 524288" )
  3427. 		If Not Err Then
  3428. 			For Each objItem in colItems
  3429. 				gvcMemory = gvcMemory + 1
  3430. 				gviMemSize = gviMemSize + objItem.Capacity
  3431. 				If gviMemSpeed = 0 Or objItem.Speed < gviMemSpeed Then gviMemSpeed = objItem.Speed
  3432. 			Next
  3433. 			MemoryModules.value = gvcMemory
  3434. 			MemorySize.value    = Round( gviMemSize / MB )
  3435.  
  3436. 			Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_PhysicalMemoryArray" )
  3437. 			For Each objItem In colItems
  3438. 				If objItem.MemoryDevices > gvcBanks Then gvcBanks = objItem.MemoryDevices
  3439. 			Next
  3440. 			ButtonDetailsMemory.disabled = False
  3441. 		End If
  3442.  
  3443. 		On Error Goto 0
  3444.  
  3445. 		MemoryBanks.value = gvcBanks
  3446.  
  3447. 		MemoryFormfactor.value = GetMemoryFormFactor( )
  3448.  
  3449. 		MemorySpeed.value = gviMemSpeed
  3450.  
  3451. 		DebugMessage "", "Memory inventory succeeded: " & CStr( Not ButtonDetailsMemory.disabled )
  3452.  
  3453. 		Add2CsvMemory
  3454. 	End If
  3455. End Sub
  3456.  
  3457.  
  3458. Sub InventoryMonitor( )
  3459. 	Dim arrMonitorDescriptions( ), arrMonitorHardwareIDs( ), arrMonitorManufacturers( ), arrMonitorSerialNumbers( )
  3460. 	Dim blnIsDesktopMonitor
  3461. 	Dim i, intHeight, intIndex, intRow, intWidth, numRatio
  3462. 	Dim colItems, colItems2, objCell, objItem, objItem2, objMatches, objRE, objTable, objTableRow, objWMIService
  3463. 	Dim strDesktopMonitorDeviceDesc, strDesktopMonitorHardwareID, strDesktopMonitorMfg, strDeviceDesc, strInstanceName
  3464. 	Dim strKey, strMfg, strQuery, strQuery2, strSerialNumberID, strSerialNumberLength, strSize
  3465.  
  3466. 	If CheckboxMonitor.Checked Then
  3467. 		On Error Resume Next ' REQUIRED
  3468.  
  3469. 		ButtonDetailsMonitor.disabled = False
  3470.  
  3471. 		' Use Win32_DesktopMonitor to get all the details for 1 monitor only
  3472. 		strQuery = "SELECT * FROM Win32_DesktopMonitor WHERE NOT Description LIKE '%Default%'"
  3473. 		Set objWMIService = GetObject( "winmgmts://" & gvscomputer & "/root/CIMV2" )
  3474. 		Set colItems      = objWMIService.ExecQuery( strQuery )
  3475. 		If Not Err Then
  3476. 			For Each objItem In colItems
  3477. 				strDesktopMonitorHardwareID = UCase( objItem.PNPDeviceID )
  3478. 				strDesktopMonitorDeviceDesc = objItem.Description
  3479. 				strDesktopMonitorMfg        = objItem.MonitorManufacturer
  3480. 			Next
  3481. 		End If
  3482. 		Set colItems      = Nothing
  3483. 		Set objWMIService = Nothing
  3484.  
  3485. 		' Use WmiMonitorID to get some details for all monitors
  3486. 		strQuery = "SELECT * FROM WmiMonitorID"
  3487. 		Set objWMIService = GetObject( "winmgmts://" & gvsComputer & "/root/WMI" )
  3488. 		Set colItems      = objWMIService.ExecQuery( strQuery )
  3489. 		If colItems.Count > 0 Then
  3490. 			ReDim arrMonitorDescriptions( colItems.Count - 1 )
  3491. 			ReDim arrMonitorHardwareIDs( colItems.Count - 1 )
  3492. 			ReDim arrMonitorManufacturers( colItems.Count - 1 )
  3493. 			ReDim arrMonitorSerialNumbers( colItems.Count - 1 )
  3494. 			arrMonitorDescriptions(0)  = strDesktopMonitorDeviceDesc
  3495. 			arrMonitorHardwareIDs(0)   = strDesktopMonitorHardwareID
  3496. 			arrMonitorManufacturers(0) = strDesktopMonitorMfg
  3497. 			intIndex = 1
  3498. 		End If
  3499. 		For Each objItem In colItems
  3500. 			strInstanceName = UCase( objItem.InstanceName )
  3501. 			'strInstanceName = Replace( UCase( Split( objItem.Path_.Path, "=" )(1) ), """", "" ) ' In case the line above doesn't work
  3502. 			blnIsDesktopMonitor = ( InStr( strInstanceName, strDesktopMonitorHardwareID ) = 1 )
  3503. 			If Not blnIsDesktopMonitor Then
  3504. 				' If this is NOT the monitor returned by Win32_DesktopMonitor then we have to query the registry for the Device Description and Manufacturer
  3505. 				' First get the DeviceID as used in the registry by removing a trailing instance index from the InstanceName (e.g. remove "_0" or "_1")
  3506. 				Set objRE = New RegExp
  3507. 				objRE.Pattern = "_\d{1,3}$"
  3508. 				If objRE.Test( strInstanceName ) Then
  3509. 					strInstanceName = objRE.Replace( strInstanceName, "" )
  3510. 				End If
  3511. 				Set objRE = Nothing
  3512. 				arrMonitorHardwareIDs( intIndex ) = strInstanceName
  3513. 				' Read the Device Description from the registry for this monitor
  3514. 				strDeviceDesc = gvoWSHShell.RegRead( "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Enum\" & strInstanceName & "\DeviceDesc" )
  3515. 				If Not IsNull( strDeviceDesc ) Then
  3516. 					If Left( strDeviceDesc, 1 ) <> "(" And InStr( strDeviceDesc, ";" ) > 1 Then
  3517. 						strDeviceDesc = Mid( strDeviceDesc, InStr( strDeviceDesc, ";" ) + 1 )
  3518. 						arrMonitorDescriptions( intIndex ) = strDeviceDesc
  3519. 					End If
  3520. 				End If
  3521. 				' Read the Manufacturer from the registry for this monitor
  3522. 				strMfg = gvoWSHShell.RegRead( "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Enum\" & strInstanceName & "\Mfg" )
  3523. 				If Not IsNull( strMfg ) Then
  3524. 					If Left( strMfg, 1 ) <> "(" And InStr( strMfg, ";" ) > 1 Then
  3525. 						strMfg = Mid( strMfg, InStr( strMfg, ";" ) + 1 )
  3526. 						arrMonitorManufacturers( intIndex ) = strMfg
  3527. 					End If
  3528. 				End If
  3529. 			End If
  3530. 			strSerialNumberLength = objItem.UserFriendlyNameLength
  3531. 			If gvaSettingsBool.Item( "DEVTEST" ) Then
  3532. 				strSerialNumberID = GetRandomString( strSerialNumberLength )
  3533. 			ElseIf strSerialNumberLength > 0 Then
  3534. 				strSerialNumberID = Chain( objItem.SerialNumberID )
  3535. 			Else
  3536. 				strSerialNumberID = ""
  3537. 			End If
  3538. 			If blnIsDesktopMonitor Then
  3539. 				arrMonitorSerialNumbers(0) = strSerialNumberID
  3540. 			Else
  3541. 				arrMonitorSerialNumbers( intIndex ) = strSerialNumberID
  3542. 			End If
  3543. 			' Get monitor dimensions for this monitor
  3544. 			strQuery2 = "SELECT * FROM WmiMonitorBasicDisplayParams WHERE InstanceName LIKE '" & Replace( strInstanceName, "\", "\\" ) & "%'"
  3545. 			Set colItems2 = objWMIService.ExecQuery( strQuery2 )
  3546. 			If Not Err Then
  3547. 				If colItems2.Count = 1 Then
  3548. 					For Each objItem2 in colItems2
  3549. 						intHeight   = objItem2.MaxVerticalImageSize
  3550. 						intWidth    = objitem2.MaxHorizontalImageSize
  3551. 						If intHeight * intWidth > 0 Then
  3552. 							numRatio = intWidth / intHeight
  3553. 							If gvaSettingsBool.Item( "CM" ) Then
  3554. 								strSize = " (" & intWidth  & " x " & intHeight & " cm"
  3555. 							Else
  3556. 								strSize = " (" & CInt( Sqr( ( intWidth * intWidth ) + ( intHeight * intHeight ) ) / 2.54 ) & """"
  3557. 							End If
  3558. 							If numRatio >= 1.45 Then
  3559. 								strSize = strSize & " widescreen"
  3560. 							End If
  3561. 							strSize = strSize & ")"
  3562. 							arrMonitorDescriptions( intIndex ) = arrMonitorDescriptions( intIndex ) & strSize
  3563. 						End If
  3564. 					Next
  3565. 				End If
  3566. 			End If
  3567. 		Next
  3568.  
  3569. 		If UBound( arrMonitorDescriptions ) >= 0 Then
  3570. 			document.getElementById( "MultipleMonitors" ).style.display = "inline"
  3571.  
  3572. 			MonitorIndex0.value        = 0
  3573. 			MonitorModel0.value        = arrMonitorDescriptions(0)
  3574. 			MonitorManufacturer0.value = arrMonitorManufacturers(0)
  3575. 			MonitorSerial0.value       = arrMonitorSerialNumbers(0)
  3576.  
  3577. 			If UBound( arrMonitorDescriptions ) > 0 Then
  3578. 				Set objTable = document.getElementById( "Results" )
  3579. 				intRow = document.getElementById( "Monitor0" ).rowIndex
  3580. 				For i = 1 To UBound( arrMonitorDescriptions )
  3581. 					Set objTableRow   = objTable.insertRow( intRow + i )
  3582. 					objTableRow.id    = "Monitor" & i
  3583. 					Set objCell       = objTableRow.insertCell( 0 )
  3584. 					objCell.innerHTML = "&nbsp;"
  3585. 					Set objCell       = objTableRow.insertCell( 1 )
  3586. 					objCell.innerHTML = "&nbsp;"
  3587. 					Set objCell       = objTableRow.insertCell( 2 )
  3588. 					objCell.innerHTML = "&nbsp;"
  3589. 					Set objCell       = objTableRow.insertCell( 3 )
  3590. 					objCell.innerHTML = "&nbsp;"
  3591. 					Set objCell       = objTableRow.insertCell( 4 )
  3592. 					objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""MonitorIndex" & i & """ size=""12"" value=""" & i & """ readonly />"
  3593. 					Set objCell       = objTableRow.insertCell( 5 )
  3594. 					objCell.innerHTML = "&nbsp;"
  3595. 					Set objCell       = objTableRow.insertCell( 6 )
  3596. 					objcell.setAttribute "colSpan", 3
  3597. 					objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""MonitorModel" & i & """ size=""40"" value=""" & arrMonitorDescriptions(i) & """ readonly />"
  3598. 					Set objCell       = objTableRow.insertCell( 7 )
  3599. 					objCell.innerHTML = "&nbsp;"
  3600. 					Set objCell       = objTableRow.insertCell( 8 )
  3601. 					objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""MonitorManufacturer" & i & """ size=""16"" value=""" & arrMonitorManufacturers(i) & """ readonly />"
  3602. 					Set objCell       = objTableRow.insertCell( 9 )
  3603. 					objCell.innerHTML = "&nbsp;"
  3604. 					Set objCell       = objTableRow.insertCell( 10 )
  3605. 					objCell.innerHTML = "<input type=""text"" oncontextmenu=""this.select()"" id=""MonitorSerial" & i & """ size=""16"" value=""" & arrMonitorSerialNumbers(i) & """ readonly />"
  3606. 					Set objCell       = Nothing
  3607. 					Set objTableRow   = Nothing
  3608. 				Next
  3609. 				Set objTable = Nothing
  3610. 			End If
  3611. 		End If
  3612.  
  3613. 		DebugMessage "", "Monitor inventory succeeded: " & CStr( Not ButtonDetailsMonitor.disabled )
  3614.  
  3615. 		On Error Goto 0
  3616. 	End If
  3617. End Sub
  3618.  
  3619.  
  3620. Sub InventoryMouse( )
  3621. 	Dim arrConnectorTypes, arrDeviceInterfaces, arrHardwareTypes, arrPointingTypes
  3622. 	Dim intButtons, intConnectorType, intCount, intMouseType
  3623. 	Dim colItems, objItem
  3624. 	Dim strConnectorType, strMouseModel, strMouseType
  3625.  
  3626. 	If CheckboxMouse.checked Then
  3627. 		' Enumeration of connector and hardware types
  3628. 		arrConnectorTypes = Array( "PS/2", "Serial","USB" )
  3629. 		arrHardwareTypes  = Array( "Standard Mouse", "Standard Pointer", "Standard Absolute Pointer", "Tablet", "Touch Screen", "Pen", "Track Ball" )
  3630. 		ReDim Preserve arrHardwareTypes( 256 )
  3631. 		arrHardwareTypes( 256 ) = "Other"
  3632. 		arrPointingTypes  = Array( "Unknown", "Other", "Unknown", "Mouse", "Trackball", "Track Point", "Glide Point", "Touch Pad", "Touch Screen", "Mouse - Optical Sensor" )
  3633. 		arrDeviceInterfaces = Array( "Unknown", "Other", "Unknown", "Serial", "PS/2", "Infrared", "HP-HIL", "Bus mouse", "ADB (Apple Desktop Bus)" )
  3634. 		ReDim Preserve arrDeviceInterfaces( 162 )
  3635. 		arrDeviceInterfaces( 160 ) = "Bus mouse DB-9"
  3636. 		arrDeviceInterfaces( 161 ) = "Bus mouse micro-DIN"
  3637. 		arrDeviceInterfaces( 162 ) = "USB"
  3638.  
  3639. 		On Error Resume Next ' REQUIRED
  3640.  
  3641. 		' Check for mouse details in root/CIMV2 - this is not likely to fail on access denied errors
  3642. 		intCount = 0
  3643. 		Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_PointingDevice" )
  3644. 		If Not Err Then
  3645. 			intCount = colItems.Count
  3646. 			If intCount > 1 Then
  3647. 				Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_PointingDevice WHERE NOT PNPDeviceID LIKE 'ACPI\\%'" )
  3648. 				intCount = colItems.Count
  3649. 				If colItems.Count = 0 Then
  3650. 					Set colItems = gvoWMIrootCimv2.ExecQuery( "SELECT * FROM Win32_PointingDevice" )
  3651. 				End If
  3652.