Rob van der Woude's Scripting Pages
Powered by GeSHi

Source code for hardware.hta

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

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