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