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