Rob van der Woude's Scripting Pages
Powered by GeSHi

Source code for updatecheck.hta

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

  1. <!DOCTYPE HTML>
  2. <html>
  3. <head>
  4. <title>UpdateCheck</title>
  5. <HTA:APPLICATION
  6.   APPLICATIONNAME="UpdateCheck"
  7.   ID="UpdateCheck"
  8.   VERSION="1.40"
  9.   SCROLL="no"
  10.   SINGLEINSTANCE="yes"/>
  11.  
  12. <style type="text/css">
  1. body, html
  2. {
  3. 	height: 100%;
  4. 	width: 100%;
  5. }
  6.  
  7. body
  8. {
  9. 	background-color: #ff8000;
  10. 	color: white;
  11. 	font-family: Arial, sans-serif;
  12. 	font-size: 12pt;
  13. 	height: 100%;
  14. 	margin: 0;
  15. 	overflow: auto;
  16. 	padding: 0;
  17. 	filter: progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='#200000', EndColorStr='#ff8000');
  18. }
  19.  
  20. a
  21. {
  22. 	color: yellow;
  23. }
  24.  
  25. div.Content
  26. {
  27. 	margin: 10px auto 10px auto;
  28. 	max-width: 1260px;
  29. 	width: 96%;
  30. }
  31.  
  32. input[type=button]
  33. {
  34. 	height: 2em;
  35. 	width: 12em;
  36. }
  37.  
  38. input[type=text]
  39. {
  40. 	text-align: right;
  41. }
  42.  
  43. td
  44. {
  45. /*
  46. 	border: 1px solid white;
  47. */
  48. 	padding: 5px 10px 0 5px;
  49. }
  50.  
  51. th
  52. {
  53. /*
  54. 	border: 1px solid white;
  55. */
  56. }
  57.  
  58. tr
  59. {
  60. 	height: 2em;
  61. 	vertical-align: middle;
  62. }
  63.  
  64. .Button
  65. {
  66. 	font-size: 12pt;
  67. 	height: 2em;
  68. 	width: 16em;
  69. }
  70.  
  71. .Center
  72. {
  73. 	margin-left: auto;
  74. 	margin-right: auto;
  75. 	text-align: center;
  76. }
  77.  
  78. .Content
  79. {
  80. 	margin: auto 0 auto 0;
  81. 	padding: auto 0 auto 0;
  82. }
  83.  
  84. .Left
  85. {
  86. 	text-align: left;
  87. }
  88.  
  89. .Right
  90. {
  91. 	text-align: right;
  92. }
  93.  
  94. #CopyrightsNotice
  95. {
  96. 	font-size:80%;
  97. 	padding-bottom: 10px;
  98. }
  1. </style>
  2.  
  3. <!-- This "HHCtrlMinimizeWindowObject" works together with the JavaScript function "minWin()" and the hidden input "MinimizeWindow" to minimize the HTA window (use "MinimizeWindow.click" in VBScript) -->
  4. <object id="HHCtrlMinimizeWindowObject" classid="clsid:adb880a6-d8ff-11cf-9377-00aa003b7a11">
  5. <param name="command" value="minimize" />
  6. </object>
  7.  
  8. <script type="text/javascript">
  9. function _jsMinWin( ) { HHCtrlMinimizeWindowObject.Click( ); };
  1. </script>
  2.  
  3. </head>
  4.  
  5. <script type="text/vbscript">
  6. Option Explicit
  7.  
  8. Const ForAppending = 8
  9. Const ForReading   = 1
  10. Const ForWriting   = 2
  11.  
  12. Const TristateFalse      =  0
  13. Const TristateMixed      = -2
  14. Const TristateTrue       = -1
  15. Const TristateUseDefault = -2
  16.  
  17. Const HKEY_CLASSES_ROOT              = &H80000000
  18. Const HKEY_CURRENT_USER              = &H80000001
  19. Const HKEY_LOCAL_MACHINE             = &H80000002
  20. Const HKEY_USERS                     = &H80000003
  21. Const HKEY_CURRENT_CONFIG            = &H80000005
  22. Const HKEY_DYN_DATA                  = &H80000006 ' Windows 95/98 only
  23.  
  24. Const REG_SZ                         =  1
  25. Const REG_EXPAND_SZ                  =  2
  26. Const REG_BINARY                     =  3
  27. Const REG_DWORD                      =  4
  28. Const REG_DWORD_BIG_ENDIAN           =  5
  29. Const REG_LINK                       =  6
  30. Const REG_MULTI_SZ                   =  7
  31. Const REG_RESOURCE_LIST              =  8
  32. Const REG_FULL_RESOURCE_DESCRIPTOR   =  9
  33. Const REG_RESOURCE_REQUIREMENTS_LIST = 10
  34. Const REG_QWORD                      = 11
  35.  
  36. Const URL_DOWNLOAD_ZIP   = "http://www.robvanderwoude.com/files/updatecheck.zip"
  37. Const URL_LATESTVER_HTA  = "http://www.robvanderwoude.com/getlatestver.php?progfile=UpdateCheck.hta"
  38. Const URL_LATESTVER_INI  = "http://www.robvanderwoude.com/getlatestver.php?progfile=UpdateCheck.ini"
  39. Const URL_PRODUCT        = "http://www.robvanderwoude.com/updatecheck.php"
  40. Const URL_WEB_INI        = "http://www.robvanderwoude.com/files/updatecheck_ini.txt"
  41.  
  42. Dim gvaCustomEntries, gvaDownloadReg, gvaHideProg, gvaHives, gvaIgnoreDots, gvaLatestVersions, gvaProgNames, gvaProgVersions
  43. Dim gvbBW, gvbChanged, gvbCustomEntries, gvbDebug, gvbDontSaveWebPages, gvbForceCheck, gvbLatestListComplete, gvbQuiet, gvbSkipDowngrades, gvbSkipNotInstalled, gvbSkipWMI, gvbUpdateProgList, gvbUpdatesFound
  44. Dim gviKeyLength, gviMinHeight, gviMinWidth, gviPID, gviWindowHeight, gviWindowWidth
  45. Dim gvoIEDebug, gvoTable, gvoUpdateTable
  46. Dim gvsCommandLine, gvsComputerName, gvsConfigFile, gvsCurDir, gvsINIFile, gvsINIVersion, gvsWebINIVersion, gvsZIPFile
  47. Dim gvtTimer
  48.  
  49.  
  50.  
  51.  
  52. Sub Backup( mySourceFile, myTargetFile )
  53. 	' Backup a file; the command processor' internal COPY command is used because it handles open files much better than the FileSystemObject does
  54. 	Dim wshShell
  55. 	Set wshShell = CreateObject( "WScript.Shell" )
  56. 	wshShell.Run "CMD.EXE /C COPY /Y """ & mySourceFile & """ """ & myTargetFile & """ >NUL 2>&1", 7, True
  57. 	Set wshShell = Nothing
  58. End Sub
  59.  
  60.  
  61.  
  62.  
  63. Sub CheckBoxClicked( myProgID )
  64. 	Dim blnSelected
  65. 	blnSelected = document.getElementById( "CheckBox_" & myProgID ).checked
  66. 	gvbChanged  = True
  67. 	ButtonSaveChanges.disabled = False
  68. End Sub
  69.  
  70.  
  71.  
  72.  
  73. Sub CheckProgUpdate( myProg )
  74. 	Dim strURL, wshShell
  75. 	If myProg = "UpdateCheckHTA" Then
  76. 		DebugMessage "Check update for UpdateCheck (this HTA)"
  77. 		strURL = URL_PRODUCT
  78. 	Else
  79. 		DebugMessage "Check update for " & ReadINI( gvsINIFile, myProg, "ProgName" )
  80. 		strURL = ReadINI( gvsINIFile, myProg, "WebsiteVersion" )
  81. 	End If
  82. 	Set wshShell = CreateObject( "Wscript.Shell" )
  83. 	wshShell.Run """" & strURL & """", 3, False
  84. 	Set wshShell = Nothing
  85. End Sub
  86.  
  87.  
  88.  
  89.  
  90. Sub ClearIECache( )
  91. 	Dim wshShell
  92. 	Set WshShell = CreateObject( "Wscript.Shell" )
  93. 	wshShell.Run "RUNDll32.EXE InetCpl.cpl,ClearMyTracksByProcess 8", 7, True
  94. 	Set WshShell = Nothing
  95. End Sub
  96.  
  97.  
  98.  
  99.  
  100. Sub ClearNotInstalled( )
  101. 	Dim i, strDebug, strKey, strVal
  102. 	strDebug = ""
  103. 	For i = 0 To gvaHideProg.Count - 1
  104. 		strKey = gvaHideProg.GetKey( i )
  105. 		strVal = gvaHideProg.Item( strKey )
  106. 		If strVal <> "" Then
  107. 			gvaProgNames.Remove strKey
  108. 			strDebug = strDebug & "Removing """ & strKey & """ from ProgNames array" & vbCrLf
  109. 		End If
  110. 	Next
  111. 	DebugMessage Strip( strDebug )
  112. End Sub
  113.  
  114.  
  115.  
  116. Sub ClearTable( )
  117. 	While gvoTable.hasChildNodes( )
  118. 		gvoTable.removeChild gvoTable.firstChild
  119. 	Wend
  120. End Sub
  121.  
  122.  
  123.  
  124.  
  125. Function CompareVersions( myVer1, myVer2 )
  126. 	' This function compares 2 version strings and returns the highest one
  127. 	Dim arrVer1, arrVer2, i, strVer1, strVer2, strVersion
  128. 	strVer1    = Replace( myVer1, "-", "." )
  129. 	strVer2    = Replace( myVer2, "-", "." )
  130. 	If strVer1 = "" Or strVer1 = "0" Then strVer1 = "0.0.0.0"
  131. 	If strVer2 = "" Or strVer2 = "0" Then strVer2 = "0.0.0.0"
  132. 	' Remove leading zeros except for the first digit
  133. 	strVer1    = Replace( strVer1, ".0", "." )
  134. 	strVer2    = Replace( strVer2, ".0", "." )
  135. 	strVer1    = Replace( strVer1, ".0", "." )
  136. 	strVer2    = Replace( strVer2, ".0", "." )
  137. 	strVer1    = Replace( strVer1, ".0", "." )
  138. 	strVer2    = Replace( strVer2, ".0", "." )
  139. 	strVer1    = Replace( strVer1, "..", ".0." )
  140. 	strVer2    = Replace( strVer2, "..", ".0." )
  141. 	strVer1    = Replace( strVer1, "..", ".0." )
  142. 	strVer2    = Replace( strVer2, "..", ".0." )
  143. 	strVer1    = Replace( strVer1, "..", ".0." )
  144. 	strVer2    = Replace( strVer2, "..", ".0." )
  145. 	If Right( strVer1, 1 ) = "." Then strVer1 = strVer1 & "0"
  146. 	If Right( strVer2, 1 ) = "." Then strVer2 = strVer2 & "0"
  147. 	strVersion = ""
  148. 	arrVer1    = Split( strVer1, "." )
  149. 	arrVer2    = Split( strVer2, "." )
  150. 	For i = 0 To Min( UBound( arrVer1 ), UBound( arrVer2 ) )
  151. 		If arrVer1(i) <> arrVer2(i) Then
  152. 			If CLng( arrVer1(i) ) > CLng( arrVer2(i) ) Then strVersion = strVer1
  153. 			If CLng( arrVer1(i) ) < CLng( arrVer2(i) ) Then strVersion = strVer2
  154. 			Exit For
  155. 		End If
  156. 	Next
  157. 	If strVersion = "" Then
  158. 		If UBound( arrVer1 ) > UBound( arrVer2 ) Then
  159. 			strVersion = strVer1
  160. 		Else
  161. 			strVersion = strVer2
  162. 		End If
  163. 	End If
  164. 	CompareVersions = strVersion
  165. End Function
  166.  
  167.  
  168.  
  169.  
  170. Sub CreateTable( )
  171. 	Dim i, j
  172. 	Dim objCell0, objCell1, objCell2, objCell3, objCell4, objRow
  173. 	Dim strProgID
  174. 	DebugMessage "Creating table for " & gvaProgNames.Count & " programs . . ."
  175. 	Set objRow   = gvoTable.insertRow(0)
  176. 	Set objCell0 = objRow.insertCell(0)
  177. 	Set objCell1 = objRow.insertCell(1)
  178. 	Set objCell2 = objRow.insertCell(2)
  179. 	Set objCell3 = objRow.insertCell(3)
  180. 	Set objCell4 = objRow.insertCell(4)
  181. 	objRow.style.fontWeight  = "bold"
  182. 	objCell0.style.textAlign = "center"
  183. 	objCell1.style.textAlign = "left"
  184. 	objCell2.style.textAlign = "right"
  185. 	objCell3.style.textAlign = "right"
  186. 	objCell4.style.width     = "8em"
  187. 	objCell0.innerHTML = "Include"
  188. 	objCell1.innerHTML = "Program Name"
  189. 	objCell2.innerHTML = "Installed Version"
  190. 	objCell3.innerHTML = "Latest Version"
  191. 	Set objCell4 = Nothing
  192. 	Set objCell3 = Nothing
  193. 	Set objCell2 = Nothing
  194. 	Set objCell1 = Nothing
  195. 	Set objCell0 = Nothing
  196. 	Set objRow   = Nothing
  197. 	For i = 0 To gvaProgNames.Count - 1
  198. 		strProgID = gvaProgNames.GetKey(i)
  199. 		j = i + 1
  200. 		Set objRow   = gvoTable.insertRow(j)
  201. 		Set objCell0 = objRow.insertCell(0)
  202. 		Set objCell1 = objRow.insertCell(1)
  203. 		Set objCell2 = objRow.insertCell(2)
  204. 		Set objCell3 = objRow.insertCell(3)
  205. 		Set objCell4 = objRow.insertCell(4)
  206. 		objCell0.style.textAlign = "center"
  207. 		objCell1.style.textAlign = "left"
  208. 		objCell2.style.textAlign = "right"
  209. 		objCell3.style.textAlign = "right"
  210. 		objCell4.style.textAlign = "center"
  211. 		objRow.id   = "Row_" & strProgID
  212. 		objCell1.id = "Progname_"         & strProgID
  213. 		objCell2.id = "InstalledVersion_" & strProgID
  214. 		objCell3.id = "LatestVersion_"    & strProgID
  215. 		objCell4.id = "VersionMatch_"     & strProgID
  216. 		objCell0.innerHTML = "<input id=""CheckBox_" & strProgID & """ type=""checkbox"" onclick=""CheckBoxClicked('" & strProgID & "')"">"
  217. 		objCell1.innerHTML = "<label for=""CheckBox_" & strProgID & """>" & gvaProgNames.Item( strProgID ) & "</label>"
  218. 		Set objCell4 = Nothing
  219. 		Set objCell3 = Nothing
  220. 		Set objCell2 = Nothing
  221. 		Set objCell1 = Nothing
  222. 		Set objCell0 = Nothing
  223. 		Set objRow   = Nothing
  224. 		document.body.scrollTop = document.body.scrollTop + document.body.scrollHeight
  225. 	Next
  226. End Sub
  227.  
  228.  
  229.  
  230.  
  231. Sub Credits( )
  232. 	If ButtonCredits.value = "Credits" Then
  233. 		AllProgTable.style.display      = "none"
  234. 		CreditsBlock.style.display      = "block"
  235. 		ButtonCredits.value             = "Back"
  236. 		ButtonSaveChanges.disabled      = True
  237. 		ButtonShowAllDownloads.disabled = True
  238. 		ButtonUpdateProgList.disabled   = True
  239. 	Else
  240. 		AllProgTable.style.display      = "block"
  241. 		CreditsBlock.style.display      = "none"
  242. 		ButtonCredits.value             = "Credits"
  243. 		ButtonShowAllDownloads.disabled = False
  244. 		ButtonSaveChanges.disabled      = False
  245. 		ButtonUpdateProgList.disabled   = False
  246. 	End If
  247. End Sub
  248.  
  249.  
  250.  
  251.  
  252. Function DebugBool( myVar )
  253. 	If IsNullOrEmpty( myVar ) Then
  254. 		DebugBool = "FALSE"
  255. 	ElseIf myVar Then
  256. 		DebugBool = "TRUE"
  257. 	Else
  258. 		DebugBool = "FALSE"
  259. 	End If
  260. End Function
  261.  
  262.  
  263.  
  264.  
  265. Sub DebugMessage( myMsg )
  266. 	If gvbDebug Then
  267. '		On Error Resume Next
  268. 		If Not IsObject( gvoIEDebug ) Then
  269. 			Set gvoIEDebug = CreateObject( "InternetExplorer.Application" )
  270. 			gvoIEDebug.Height = gviWindowHeight
  271. 			gvoIEDebug.Width  = gviWindowWidth
  272. 			gvoIEDebug.AddressBar = False
  273. 			gvoIEDebug.MenuBar    = False
  274. 			gvoIEDebug.StatusBar  = False
  275. 			gvoIEDebug.ToolBar    = False
  276. 			gvoIEDebug.Visible    = True
  277. 			gvoIEDebug.Navigate "about:blank"
  278. 			gvoIEDebug.Document.title = "UpdateCheck " & UpdateCheck.Version & " Debugging Info"
  279. 		End If
  280. 		gvoIEDebug.Document.body.innerHTML = gvoIEDebug.Document.body.innerHTML & vbCrLf & "<pre>" & vbCrLf & myMsg & vbCrLf & "</pre>" & vbCrLf
  281. 		' Scroll IE to end of document
  282. 		' http://stackoverflow.com/questions/5936668/vbscript-how-to-force-the-ie-scroll-bars-to-lock-to-the-bottom
  283. 		gvoIEDebug.Document.body.scrollTop = gvoIEDebug.Document.body.scrollTop + gvoIEDebug.Document.body.scrollHeight
  284. 		On Error Goto 0
  285. 	End If
  286. End Sub
  287.  
  288.  
  289.  
  290.  
  291. Function DebugProgList( )
  292. 	Dim i, strMsg, strProgID
  293. 	strMsg = "<b>List of programs, read from INI file:</b>" & vbCrLf & vbCrLf
  294. 	For i = 0 To gvaProgNames.Count - 1
  295. 		strProgID = gvaProgNames.GetKey( i )
  296. 		gviKeyLength = Max( gviKeyLength, Len( strProgID ) )
  297. 	Next
  298. 	For i = 0 To gvaProgNames.Count - 1
  299. 		strProgID = gvaProgNames.GetKey(i)
  300. 		strMsg = strMsg & Pad( strProgID, gviKeyLength ) & " = " & gvaProgNames.Item( strProgID ) & vbCrLf
  301. 	Next
  302. 	DebugProgList = strMsg
  303. End Function
  304.  
  305.  
  306.  
  307.  
  308. Function Download( myURL, myFile )
  309. 	Dim i, intLen, objFile, objFSO, objHTTP
  310. 	intLen = 0
  311. '	On Error Resume Next
  312. 	Set objFSO  = CreateObject( "Scripting.FileSystemObject" )
  313. 	Set objFile = objFSO.OpenTextFile( myFile, ForWriting, True )
  314. 	Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
  315. 	objHTTP.Open "GET", myURL, False
  316. 	objHTTP.Send
  317. 	' Write the downloaded byte stream to the target file
  318. 	intLen = LenB( objHTTP.ResponseBody )
  319. 	For i = 1 To intLen
  320. 		objFile.Write Chr( AscB( MidB( objHTTP.ResponseBody, i, 1 ) ) )
  321. 	Next
  322. 	objFile.Close( )
  323. 	On Error Goto 0
  324. 	Set objHTTP = Nothing
  325. 	Set objFile = Nothing
  326. 	Set objFSO  = Nothing
  327. 	Download = intLen
  328. End Function
  329.  
  330.  
  331.  
  332.  
  333. Sub DownloadProgUpdate( myProg )
  334. 	Dim intAnswer, intButtons
  335. 	Dim strMsg, strTitle, strURL, wshShell
  336. 	If myProg = "UpdateCheckHTA" Then
  337. 		DebugMessage "Download update for UpdateCheck (this HTA)"
  338. 	Else
  339. 		DebugMessage "Download update for " & ReadINI( gvsINIFile, myProg, "ProgName" )
  340. 	End If
  341. 	If gvaDownloadReg.Item( myProg ) <> "" Then
  342. 		strMsg     = "The general download page for this software allows you to either buy or renew a license, or download a trial version." & vbCrLf _
  343. 		           & "If you bought a license before, check with the manufacturer or vendor to see if you are entitled to a free upgrade." & vbCrLf _
  344. 		           & "If so, you may need an alternative URL to download a registered version." & vbCrLf & vbCrLf _
  345. 		           & "Do you want to continue navigating to the general download page?"
  346. 		strTitle   = "Unregistered Download"
  347. 		intButtons = vbYesNoCancel + vbInformation + vbApplicationModal
  348. 		intAnswer  = MsgBox( strMsg, intButtons, strTitle )
  349. 		If intAnswer <> vbYes Then Exit Sub
  350. 	End If
  351. 	Set wshShell = CreateObject( "Wscript.Shell" )
  352. 	If myProg = "UpdateCheckHTA" Then
  353. 		wshShell.Run """" & URL_PRODUCT & """"
  354. 	ElseIf myProg = "UpdateCheckINI" Then
  355. 		Backup gvsINIFile, gvsINIFile & "." & gvsINIVersion & ".backup." & TimeStamp( )
  356. 		Download URL_WEB_INI, gvsINIFile
  357. 	Else
  358. 		wshShell.Run """" & ReadINI( gvsINIFile, myProg, "WebsiteDownload" ) & """"
  359. 	End If
  360. 	Set wshShell = Nothing
  361. End Sub
  362.  
  363.  
  364.  
  365.  
  366. Function Escape( myText )
  367. 	Dim strText
  368. 	strText = Replace( myText, "&", "&amp;" )
  369. 	strText = Replace( strText, "<", "&lt;" )
  370. 	strText = Replace( strText, ">", "&gt;" )
  371. 	Escape = strText
  372. End Function
  373.  
  374.  
  375.  
  376.  
  377. Sub Extract( myZIPFile, myTargetDir )
  378. 	Dim intOptions, objShell, objSource, objTarget
  379. 	Set objShell  = CreateObject( "Shell.Application" )
  380. 	Set objSource = objShell.NameSpace( myZIPFile ).Items( )
  381. 	Set objTarget = objShell.NameSpace( myTargetDir )
  382. 	' These are the available CopyHere options, according to MSDN
  383. 	' (http://msdn2.microsoft.com/en-us/library/ms723207.aspx).
  384. 	' On my test systems, however, the options were completely ignored.
  385. 	'      4: Do not display a progress dialog box.
  386. 	'      8: Give the file a new name in a move, copy, or rename operation if a file with the target name already exists.
  387. 	'     16: Click "Yes to All" in any dialog box that is displayed.
  388. 	'     64: Preserve undo information, if possible.
  389. 	'    128: Perform the operation on files only if a wildcard file name (*.*) is specified.
  390. 	'    256: Display a progress dialog box but do not show the file names.
  391. 	'    512: Do not confirm the creation of a new directory if the operation requires one to be created.
  392. 	'   1024: Do not display a user interface if an error occurs.
  393. 	'   4096: Only operate in the local directory. Don't operate recursively into subdirectories.
  394. 	'   8192: Do not copy connected files as a group. Only copy the specified files.
  395. 	intOptions = 16 + 256
  396. 	objTarget.CopyHere objSource, intOptions
  397. 	Set objSource = Nothing
  398. 	Set objTarget = Nothing
  399. 	Set objShell  = Nothing
  400. End Sub
  401.  
  402.  
  403.  
  404.  
  405. Function GetFileVersion( myFile )
  406. 	Dim objFSO, strFile
  407. 	GetFileVersion = "0"
  408. 	On Error Resume Next
  409. 	Set objFSO = CreateObject( "Scripting.FileSystemObject" )
  410. 	strFile = objFSO.GetAbsolutePathName( myFile )
  411. 	GetFileVersion = objFSO.GetFileVersion( strFile )
  412. 	If Err Then
  413. 		DebugMessage "Error finding file version for """ & strFile & """:" & vbCrLf & Err.Description
  414. 	End If
  415. 	Set objFSO = Nothing
  416. 	On Error Goto 0
  417. End Function
  418.  
  419.  
  420.  
  421.  
  422. Function GetInstalledVersion( myProg, myINI )
  423. 	Dim arrDisplay
  424. 	Dim blnSearchPath, blnTryInstLoc, blnUseProdVer
  425. 	Dim colInstances, objExec, objFile, objInstance , objFSO, objMatches, objRE, objWMIService, wshShell
  426. 	Dim strCmdLine, strCmdOutput, strCmdGrep, strDebug, strDisplayName, strExec, strExec2, strExt, strHTAText
  427. 	Dim strLatest, strName, strPath, strPrompt, strRegPath, strRegPath2, strRegVersion, strRegVersion2
  428. 	Dim strSearchPath, strTitle, strTryInstLoc, strUseProdVer, strVersion, strWin32Product
  429.  
  430. 	If myProg = "UpdateCheckHTA" Then
  431. 		GetInstalledVersion = UpdateCheck.Version
  432. 		Exit Function
  433. 	End If
  434.  
  435. 	Set wshShell = CreateObject( "Wscript.Shell" )
  436. 	Set objFSO   = CreateObject( "Scripting.FileSystemObject" )
  437.  
  438. 	' Read values for specified program from UpdateCheck.ini
  439. 	strCmdLine      = ReadINI( myINI, myProg, "CommandLine" )
  440. 	strCmdGrep      = ReadINI( myINI, myProg, "OutputGrep" )
  441. 	strDisplayName  = ReadINI( myINI, myProg, "DisplayName" )
  442. 	strExec         = wshShell.ExpandEnvironmentStrings( ReadINI( myINI, myProg, "Executable" ) )
  443. 	strExec2        = wshShell.ExpandEnvironmentStrings( ReadINI( myINI, myProg, "Executable2" ) )
  444. 	strRegPath      = wshShell.ExpandEnvironmentStrings( ReadINI( myINI, myProg, "RegPath" ) )
  445. 	strRegPath2     = wshShell.ExpandEnvironmentStrings( ReadINI( myINI, myProg, "RegPath2" ) )
  446. 	strRegVersion   = ReadINI( myINI, myProg, "RegVersion" )
  447. 	strRegVersion2  = ReadINI( myINI, myProg, "RegVersion2" )
  448. 	strSearchPath   = ReadINI( myINI, myProg, "SearchPATH" )
  449. 	strTryInstLoc   = ReadINI( myINI, myProg, "TryInstallLocation" )
  450. 	strUseProdVer   = ReadINI( myINI, myProg, "UseProductVersion" )
  451. 	strVersion      = ReadINI( myINI, myProg, "Version" )
  452. 	strWin32Product = ReadINI( myINI, myProg, "Win32Product" )
  453. 	If strVersion = "" Then strVersion = "0"
  454. 	strDebug = "<b>[" & Now & "]</b> INI entry for detection of <b>""" & gvaProgNames.Item( myProg ) & """</b> version:"   & vbCrLf & vbCrLf
  455. 	If myProg = "UpdateCheckINI" Then
  456. 		strDebug = strDebug & "Version = """ & strVersion & """" & vbCrLf
  457. 	Else
  458. 		strDebug = strDebug _
  459. 		         & "CommandLine        = """ & Escape( strCmdLine )       & """" & vbCrLf _
  460. 		         & "DisplayName        = """ & strDisplayName             & """" & vbCrLf _
  461. 		         & "Executable         = """ & strExec                    & """" & vbCrLf _
  462. 		         & "Executable2        = """ & strExec2                   & """" & vbCrLf _
  463. 		         & "OutputGrep         = """ & Escape( strCmdGrep )       & """" & vbCrLf _
  464. 		         & "RegPath            = """ & strRegPath                 & """" & vbCrLf _
  465. 		         & "RegPath2           = """ & strRegPath2                & """" & vbCrLf _
  466. 		         & "RegVersion         = """ & strRegVersion              & """" & vbCrLf _
  467. 		         & "RegVersion2        = """ & strRegVersion2             & """" & vbCrLf _
  468. 		         & "SearchPATH         = """ & DebugBool( strSearchPath ) & """" & vbCrLf _
  469. 		         & "TryInstallLocation = """ & DebugBool( strTryInstLoc ) & """" & vbCrLf _
  470. 		         & "UseProductVersion  = """ & DebugBool( strUseProdVer ) & """" & vbCrLf _
  471. 		         & "Win32Product       = """ & strWin32Product            & """" & vbCrLf
  472. 	End If
  473. 	DebugMessage strDebug
  474.  
  475. 	If strVersion = "0" Then
  476. 		If strCmdLine <> "" Then ' Determine the executable version by running it (parent folder must be in the PATH)
  477. 			strVersion = SearchCommandOutput( strCmdLine, strCmdGrep )
  478. 		ElseIf strDisplayName <> "" Then ' Search the registry for matching DisplayNames and return the DisplayVersion
  479. 			strVersion = SearchDisplayName( myProg, strDisplayName )
  480. 		ElseIf strRegVersion <> "" Then
  481. 			strVersion = SearchRegVersion( myProg, strRegVersion, strRegVersion2 )
  482. 		'ElseIf strRegPath <> "" And strExec <> "" Then ' Read the executable's location from the registry
  483. 		ElseIf strRegPath <> "" Then ' Read the executable's location from the registry
  484. 			strVersion = SearchRegPath( myProg, strRegPath, strRegPath2, strExec, strUseProdVer )
  485. 		ElseIf strSearchPath <> "" And strExec <> "" Then ' Find the executable file and determine its version
  486. 			strVersion = SearchPATH( myProg, strExec, strUseProdVer )
  487. 		ElseIf strExec <> "" Then
  488. 			If strUseProdVer = "" Then
  489. 				strVersion = GetFileVersion( strExec )
  490. 				If strVersion = "0" And strExec2 <> "" Then strVersion = GetFileVersion( strExec2 )
  491. 			Else
  492. 				strVersion = GetProductVersion( strExec )
  493. 				If strVersion = "0" And strExec2 <> "" Then strVersion = GetProductVersion( strExec2 )
  494. 			End If
  495. 		ElseIf strWin32Product <> "" Then ' Use WMI to determine the installed version
  496. 			If gvbSkipWMI And gvbDebug Then
  497. 				DebugMessage "Command line switch /SKIPWMI forces us to skip WMI based version detections while debugging."
  498. 			Else
  499. 				strVersion = SearchWMI( myProg, strWin32Product, strTryInstLoc, strExec, strUseProdVer )
  500. 			End If
  501. 		Else ' Invalid combination of parameters
  502. 			strVersion = "ERROR"
  503. 			DebugMessage "Invalid INI entry for " & myProg
  504. 		End If
  505. 	End If
  506.  
  507. 	DebugMessage "<b>[" & Now & "]</b> Detected version: " & strVersion
  508. 	strVersion = Trim( Replace( strVersion, "-", "." ) )
  509. 	If strVersion = "" Or strVersion = "0" Or strVersion = "0.0.0.0" Then
  510. 		DebugMessage "<b>Installed version: N/A"
  511. 	Else
  512. 		DebugMessage "<b>Installed version: " & strVersion & "</b>"
  513. 	End If
  514.  
  515. 	GetInstalledVersion = strVersion
  516. End Function
  517.  
  518.  
  519.  
  520.  
  521. Function GetLatestVersion( myProg, myINI )
  522. 	Dim blnDownloadReg, blnIgnoreDots, blnWGetUseIE
  523. 	Dim objFSO, objHTTP, objIE, objLogFile, objMatch, objMatches, objRE
  524. 	Dim strDebug, strDisplayName, strDownloadReg, strHTML, strIgnoreDots, strLogFile, strPattern, strTest, strText, strUserAgent, strVersion, strWGetUseIE
  525. 	Dim urlCheck, urlDownload
  526.  
  527. 	' For this HTA, a simpler check suffices
  528. 	If myProg = "UpdateCheckHTA" Then
  529. 		GetLatestVersion = TextFromHTML( URL_LATESTVER_HTA )
  530. 		Exit Function
  531. 	End If
  532.  
  533. '	On Error Resume Next
  534.  
  535. 	' Initial return string, in case an error occurs
  536. 	strVersion = "0"
  537. 	strHTML    = ""
  538. 	' Read the required web page URL and regex pattern from the INI file
  539. 	strDisplayName = ReadINI( myINI, myProg, "DisplayName" )
  540. 	strDownloadReg = ReadINI( myINI, myProg, "DownloadRegistered" )
  541. 	If strDownloadReg = "" Then
  542. 		blnDownloadReg = False
  543. 	Else
  544. 		blnDownloadReg = True
  545. 	End If
  546. 	strIgnoreDots = ReadINI( myINI, myProg, "IgnoreDots" )
  547. 	If strIgnoreDots = "" Then
  548. 		blnIgnoreDots = False
  549. 	Else
  550. 		blnIgnoreDots = True
  551. 	End If
  552. 	strPattern   = ReadINI( myINI, myProg, "RegexPattern" )
  553. 	urlDownload  = ReadINI( myINI, myProg, "WebsiteDownload" )
  554. 	urlCheck     = ReadINI( myINI, myProg, "WebsiteVersion" )
  555. 	strWGetUseIE = ReadINI( myINI, myProg, "WGetUseIE" )
  556. 	If strWGetUseIE = "" Then
  557. 		blnWGetUseIE = False
  558. 	Else
  559. 		blnWGetUseIE = True
  560. 	End If
  561. 	DebugMessage "<b>[" & Now & "]</b> INI entry for detection of <em>latest</em> <b>""" & gvaProgNames.Item( myProg ) & """</b> version:"   & vbCrLf & vbCrLf _
  562. 	           & "DownloadRegistered = """ & DebugBool( blnDownloadReg ) & """" & vbCrLf _
  563. 	           & "IgnoreDots         = """ & DebugBool( blnIgnoreDots )  & """" & vbCrLf _
  564. 	           & "RegexPattern       = """ & Escape( strPattern )        & """" & vbCrLf _
  565. 	           & "WebsiteDownload    = """ & urlDownload                 & """" & vbCrLf _
  566. 	           & "WebsiteVersion     = """ & urlCheck                    & """" & vbCrLf _
  567. 	           & "WGetUseIE          = """ & DebugBool( blnWGetUseIE )   & """" & vbCrLf
  568. 	If urlCheck = "" Or strPattern = "" Then Exit Function
  569. 	If blnWGetUseIE Then
  570. 		DebugMessage "WGetUseIE = """ & strWGetUseIE & """ (" & DebugBool( blnWGetUseIE ) & "): using Internet Explorer to read web page"
  571.  
  572. 		On Error Resume Next
  573.  
  574. 		' Use Internet Explorer to read the text from the specified web page
  575. 		Set objIE = CreateObject( "InternetExplorer.Application" )
  576. 		objIE.Visible = False
  577. 		objIE.Navigate2 urlCheck
  578. 		Do While objIE.Busy
  579. 			strTest = ReadINI( myINI, myProg, "RegexPattern" ) ' Anything that takes a while
  580. 		Loop
  581. 		strHTML = objIE.Document.body.innerHTML
  582. 		If Err Then
  583. 			strDebug = "Error using Internet Explorer to retrieve web page """ & urlCheck & """:" & vbCrLf & Err.Description & vbCrLf & Err.Source
  584. 			strDebug = strDebug & vbCrLf & "Retrieved " & Len( strHTML ) & " bytes."
  585. 			strDebug = strDebug & vbCrLf & "Returned status: " & objIE.StatusText
  586. 			DebugMessage strDebug
  587. 		End If
  588.  
  589. 		On Error Goto 0
  590.  
  591. 		objIE.Quit
  592. 		Set objIE = Nothing
  593. 	Else
  594. 		DebugMessage "WGetUseIE = """ & strWGetUseIE & """ (" & DebugBool( blnWGetUseIE ) & "): using WinHTTP to read web page"
  595.  
  596. 		On Error Resume Next
  597.  
  598. 		' Use WinHTTP to read the text from the specified web page
  599. 		Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
  600. 		objHTTP.Open "GET", urlCheck, False
  601. 		strUserAgent = "Mozilla/5.0 (Windows NT 6.1; WOW64; rv:30.0) Gecko/20100101 Firefox/30.0"
  602. 		objHTTP.SetRequestHeader "UserAgent", strUserAgent
  603. 		objHTTP.SetTimeouts 2000, 30000, 15000, 30000
  604. 		objHTTP.Send
  605. 		If objHTTP.Status = 200 And Err.Number = 0 Then
  606. 			strHTML = objHTTP.ResponseText
  607. 		Else
  608. 			DebugMessage "Error searching for latest version of """ & myProg & """: " & objHTTP.StatusText & " (" & objHTTP.Status & ")"
  609. 		End If
  610. 		Set objHTTP = Nothing
  611.  
  612. 		On Error Goto 0
  613. 	End If
  614.  
  615. 	If Len( strHTML ) = 0 Then
  616. 		DebugMessage "Error reading web page"
  617. 	Else
  618. 		If gvbDebug And Not gvbDontSaveWebPages Then
  619. 			Set objFSO = CreateObject( "Scripting.FileSystemObject" )
  620. 			strLogFile = "UpdateCheck.GetLatestVersion." & myProg & "." & TimeStamp( ) & ".html"
  621. 			strLogFile = objFSO.BuildPath( Self.location.pathname & ".\..", strLogFile )
  622. 			strLogFile = objFSO.GetAbsolutePathName( strLogFile )
  623. 			On Error Resume Next
  624. 			Set objLogFile = objFSO.OpenTextFile( strLogFile, ForWriting, True, TristateFalse )
  625. 			objLogFile.Write strHTML
  626. 			objLogFile.Close
  627. 			If Err Then
  628. 				DebugMessage "Error saving web page for version check as """ & strLogFile & """:" & vbCrLf & Err.Description
  629. 			Else
  630. 				DebugMessage "Saved web page for version check as """ & strLogFile & """"
  631. 			End If
  632. 			On Error Goto 0
  633. 			Set objLogFile = Nothing
  634. 			Set objFSO     = Nothing
  635. 		End If
  636. 	End If
  637.  
  638. 	Set objRE = New RegExp
  639. 	objRE.Pattern    = strPattern
  640. 	objRE.IgnoreCase = False
  641. 	objRE.Global     = True
  642. 	Set objMatches = objRE.Execute( strHTML )
  643. 	strDebug = "Using the following regex pattern to search for the version number:" & vbCrLf & Escape( strPattern ) & vbCrLf
  644. 	If objMatches.Count = 0 Then
  645. 		strDebug = strDebug & "No match found."
  646. 	ElseIf objMatches.Count = 1 Then
  647. 		strDebug = strDebug & "1 match found: " & Escape( objMatches.Item(0) )
  648. 	Else
  649. 		strDebug = strDebug & objMatches.Count & " matches found:"
  650. 		For Each objMatch In objMatches
  651. 			strDebug = strDebug & vbCrLf & Escape( objMatch.Value )
  652. 		Next
  653. 	End If
  654. 	If objMatches.Count > 0 Then
  655. 		For Each objMatch In objMatches.Item(0).Submatches
  656. 			strDebug = strDebug & vbCrLf & "Submatch: " & Escape( objMatch )
  657. 			strVersion = objMatch
  658. 		Next
  659. 	End If
  660. 	DebugMessage strDebug
  661. 	' Remove leading zeros
  662. 	strVersion = Replace( strVersion, "(", "" )
  663. 	strVersion = Replace( strVersion, ")", "" )
  664. 	strVersion = Replace( strVersion, " ", "." )
  665. 	strVersion = Replace( strVersion, "-", "." )
  666. 	Set objMatch = Nothing
  667. 	Set objRE    = Nothing
  668.  
  669. 	On Error Goto 0
  670.  
  671. 	' Return the result
  672. 	GetLatestVersion = strVersion
  673. End Function
  674.  
  675.  
  676.  
  677.  
  678. Sub GetPID( )
  679. 	Dim colInstances, objInstance, objWMIService
  680. 	gviPID = 0
  681. 	On Error Resume Next
  682. 	Set objWMIService = GetObject( "winmgmts://./root/CIMV2" )
  683. 	Set colInstances = objWMIService.ExecQuery( "SELECT * FROM Win32_Process WHERE Name='mshta.exe' AND CommandLine LIKE '%" & Replace( Self.location.pathname, "\", "\\" ) & "%'" )
  684. 	If colInstances.Count <> 1 Then Exit Sub
  685. 	For Each objInstance In colInstances
  686. 		gviPID = objInstance.ProcessId
  687. 	Next
  688. 	On Error Goto 0
  689. End Sub
  690.  
  691.  
  692.  
  693.  
  694. Function GetProductVersion( myFile )
  695. 	' Based on code by Maputi on StackOverflow.com:
  696. 	' http://stackoverflow.com/questions/2976734/how-to-retrieve-a-files-product-version-in-vbscript
  697. 	Dim arrTranslations
  698. 	Dim i
  699. 	Dim objFolder, objFolderItem, objFSO, objShell
  700. 	Dim strFileName, strPropertyName, strParentFolder, strVersion
  701.  
  702. 	' Note that property names are language dependent, so you may have to add the lower case property name for your own language
  703. 	Set arrTranslations = CreateObject( "System.Collections.ArrayList" )
  704. 	arrTranslations.Add "product version" ' English
  705. 	arrTranslations.Add "productversie"   ' Dutch
  706.  
  707. 	strVersion = "0"
  708. 	Set objFSO = CreateObject( "Scripting.FileSystemObject" )
  709. 	If objFSO.FileExists( myFile ) Then
  710. 		strFileName       = objFSO.GetFileName( myFile )
  711. 		strParentFolder   = objFSO.GetParentFolderName( myFile )
  712. 		Set objShell      = CreateObject( "Shell.Application" )
  713. 		Set objFolder     = objShell.Namespace( strParentFolder )
  714. 		Set objFolderItem = objFolder.ParseName( strFileName )
  715. 		For i = 0 To 300
  716. 			strPropertyName = objFolder.GetDetailsOf( objFolder.Items, i )
  717. 			If arrTranslations.Contains( LCase( strPropertyName ) ) Then
  718. 				strVersion = objFolder.GetDetailsOf( objFolderItem, i )
  719. 				DebugMessage "Product version of """ & strFileName & """ is """ & strVersion & """ (file property """ & strPropertyName & """, index " & i & ")"
  720. 				Exit For
  721. 			End If
  722. 		Next
  723. 		Set objFolderItem = Nothing
  724. 		Set objFolder     = Nothing
  725. 		Set objShell      = Nothing
  726. 		If strVersion = 0 Then DebugMessage "Product version of """ & strFileName & """ not found"
  727. 	Else
  728. 		DebugMessage "File not found:" & vbCrLf & """" & strFileName & """"
  729. 	End If
  730. 	Set objFSO          = Nothing
  731. 	Set arrTranslations = Nothing
  732.  
  733. 	GetProductVersion = strVersion
  734. End Function
  735.  
  736.  
  737.  
  738.  
  739. Sub Help( )
  740. 	Dim wshShell
  741. 	Set wshShell = CreateObject( "Wscript.Shell" )
  742. 	wshShell.Run "http://www.robvanderwoude.com/updatecheckhelp.php", 3, False
  743. 	Set wshShell = Nothing
  744. End Sub
  745.  
  746.  
  747.  
  748.  
  749. Sub Initialize( )
  750. 	Dim arrSize, blnConfigFile, objAnchor, objConfigFile, objFSO, objSysInfo, strConfigText, strDebug, strSize, wshShell
  751. 	Set wshShell = CreateObject( "Wscript.Shell" )
  752. 	blnConfigFile  = False
  753. 	gvsCommandLine = UpdateCheck.CommandLine
  754. 	Set objSysInfo = CreateObject( "WinNTSystemInfo" )
  755. 	gvsComputerName = objSysInfo.ComputerName
  756. 	Set objSysInfo = Nothing
  757. 	' File names and locations
  758. 	Set objFSO = CreateObject( "Scripting.FileSystemObject" )
  759. 	With objFSO
  760. 		gvsCurDir     = .GetParentFolderName( Self.location.pathname )
  761. 		gvsZIPFile    = .BuildPath( gvsCurDir, "updatecheck.zip" )
  762. 		gvsINIFile    = .BuildPath( gvsCurDir, "UpdateCheck.ini" )
  763. 		gvsConfigFile = .BuildPath( gvsCurDir, "UpdateCheck.cfg" )
  764. 		' Download INI from the web if local INI file not found
  765. 		If Not .FileExists( gvsINIFile ) Then
  766. 			DebugMessage "Downloading default INI file from the website . . ."
  767. 			Download URL_WEB_INI, gvsINIFile
  768. 		End If
  769. 		' Add configuration file parameters to command line
  770. 		If .FileExists( gvsConfigFile ) Then
  771. 			blnConfigFile = True
  772. 			Set objConfigFile = .OpenTextFile( gvsConfigFile, ForReading, False, TristateUseDefault )
  773. 			strConfigText = objConfigFile.ReadAll( )
  774. 			objConfigFile.Close
  775. 			Set objConfigFile = Nothing
  776. 			strConfigText = Replace( strConfigText, vbCrLf, " " )
  777. 			strConfigText = Replace( strConfigText, vbCr,   " " )
  778. 			strConfigText = Replace( strConfigText, vbLf,   " " )
  779. 			strConfigText = Replace( strConfigText, vbTab,  " " )
  780. 			strConfigText = Replace( strConfigText, "   ",  " " )
  781. 			strConfigText = Replace( strConfigText, "  ",   " " )
  782. 			gvsCommandLine = Trim( gvsCommandLine ) & " " & Trim( strConfigText )
  783. 		End If
  784. 	End With
  785. 	Set objFSO = Nothing
  786. 	gviKeyLength    =   0
  787. 	gviMinHeight    = 600
  788. 	gviMinWidth     = 800
  789. 	gviWindowHeight = 850
  790. 	gviWindowWidth  = 900
  791. 	gvbBW               = CBool( InStr( UCase( gvsCommandLine ), "/BW" ) )
  792. 	gvbDebug            = CBool( InStr( UCase( gvsCommandLine ), "/DEBUG" ) )
  793. 	gvbDontSaveWebPages = CBool( InStr( UCase( gvsCommandLine ), "/DSWP" ) )
  794. 	gvbForceCheck       = CBool( InStr( UCase( gvsCommandLine ), "/FORCE" ) )
  795. 	gvbQuiet            = CBool( InStr( UCase( gvsCommandLine ), "/QUIET" ) )
  796. 	gvbSkipDowngrades   = CBool( InStr( UCase( gvsCommandLine ), "/SKIPDOWNGRADE" ) )
  797. 	gvbSkipNotInstalled = CBool( InStr( UCase( gvsCommandLine ), "/SKIPNOTINSTALLED" ) )
  798. 	gvbSkipWMI          = CBool( InStr( UCase( gvsCommandLine ), "/SKIPWMI" ) )
  799. 	gvbChanged            = False
  800. 	gvbCustomEntries      = False
  801. 	gvbLatestListComplete = False
  802. 	gvbUpdateProgList     = False
  803. 	gvbUpdatesFound       = False
  804.  
  805. '	On Error Resume Next
  806.  
  807. 	' Get the currently installed INI file version
  808. 	gvsINIVersion = ReadINI( gvsINIFile, "UpdateCheckINI", "Version" )
  809. 	If gvsINIVersion = "" Then gvsINIVersion = "1.20"
  810.  
  811. 	On Error Goto 0
  812.  
  813. 	' Table to contain program list and results
  814. 	Set gvoTable = document.getElementById( "AllProgTable" )
  815. 	document.title = UpdateCheck.ApplicationName & ", Version " & UpdateCheck.Version
  816. 	CopyrightsNotice.innerHTML = UpdateCheck.ApplicationName & ",  Version " & UpdateCheck.Version & "<br>&copy; 2014 Rob van der Woude"
  817. 	' Set window dimensions
  818. 	If InStr( UCase( gvsCommandLine ), "/SIZE:" ) Then
  819. 		strSize = UCase( Mid( gvsCommandLine, InStr( UCase( gvsCommandLine ), "/SIZE:" ) + 6 ) )
  820. 		If InStr( strSize, " " ) Then
  821. 			strSize = Left( strSize, InStr( strSize, " " ) - 1 )
  822. 		End If
  823. 		If InStr( strSize, "X" ) Then
  824. 			arrSize = Split( strSize, "X" )
  825. 			If UBound( arrSize ) = 1 Then
  826. 				If IsNumeric( arrSize(0) ) And IsNumeric( arrSize(1) ) Then
  827. 					gviWindowHeight = Max( CInt( arrSize(1) ), gviMinHeight )
  828. 					gviWindowWidth  = Max( CInt( arrSize(0) ), gviMinWidth  )
  829. 				End If
  830. 			End If
  831. 		End If
  832. 	End If
  833. 	' SortedList objects to contain program properties
  834. 	Set gvaCustomEntries  = CreateObject( "System.Collections.Sortedlist" )
  835. 	Set gvaDownloadReg    = CreateObject( "System.Collections.Sortedlist" )
  836. 	Set gvaHideProg       = CreateObject( "System.Collections.Sortedlist" )
  837. 	Set gvaIgnoreDots     = CreateObject( "System.Collections.Sortedlist" )
  838. 	Set gvaLatestVersions = CreateObject( "System.Collections.Sortedlist" )
  839. 	Set gvaProgNames      = CreateObject( "System.Collections.Sortedlist" )
  840. 	Set gvaProgVersions   = CreateObject( "System.Collections.Sortedlist" )
  841. 	strDebug = UpdateCheck.Applicationname & ",  Version " & UpdateCheck.Version & vbCrLf & vbCrLf _
  842. 	         & "Logging started "          & Now        & vbCrLf & vbCrLf _
  843. 	         & "<h1>* * * PART I: INITIALIZATION * * *</h1>"     & vbCrLf & vbCrLf _
  844. 	         & "INI file: """              & gvsINIFile & """"   & vbCrLf & vbCrLf _
  845. 	         & "Registered INI version: "  & gvsINIVersion       & vbCrLf & vbCrLf _
  846. 	         & "Command line           : " & UpdateCheck.CommandLine    & vbCrLf _
  847. 	         & "Config file found      : " & DebugBool( blnConfigFile ) & vbCrLf
  848. 	If blnConfigFile Then strDebug = strDebug & "Config file content    : """ & Trim( strConfigText ) & """" & vbCrLf
  849. 	strDebug = strDebug _
  850. 	         & "Resulting command line : " & gvsCommandLine      & vbCrLf & vbCrLf _
  851. 	         & "Debug Mode         = " & DebugBool( gvbDebug )            & vbCrLf _
  852. 	         & "Show all downloads = " & DebugBool( gvbForceCheck )       & vbCrLf _
  853. 	         & "Quiet mode         = " & DebugBool( gvbQuiet )            & vbCrLf _
  854. 	         & "Skip downgrades    = " & DebugBool( gvbSkipDowngrades )   & vbCrLf _
  855. 	         & "Skip not installed = " & DebugBool( gvbSkipNotInstalled ) & vbCrLf _
  856. 	         & "Skip WMI searches  = " & DebugBool( gvbSkipWMI )          & vbCrLf _
  857. 	         & "Black and White    = " & DebugBool( gvbBW )               & vbCrLf _
  858. 	         & "Window size        = " & gviWindowWidth & " x " & gviWindowHeight
  859. 	DebugMessage strDebug
  860. 	' Hive string to constant conversions use a dictionary object
  861. 	Set gvaHives = CreateObject( "Scripting.Dictionary" )
  862. 	gvaHives.Item( "HKEY_CLASSES_ROOT" )   = HKEY_CLASSES_ROOT
  863. 	gvaHives.Item( "HKEY_CURRENT_USER" )   = HKEY_CURRENT_USER
  864. 	gvaHives.Item( "HKEY_LOCAL_MACHINE" )  = HKEY_LOCAL_MACHINE
  865. 	gvaHives.Item( "HKEY_USERS" )          = HKEY_USERS
  866. 	gvaHives.Item( "HKEY_CURRENT_CONFIG" ) = HKEY_CURRENT_CONFIG
  867. 	gvaHives.Item( "HKEY_DYN_DATA" )       = HKEY_DYN_DATA
  868. 	Set wshShell = Nothing
  869. 	If gvbBW Then
  870. 		document.body.style.backgroundColor = "white"
  871. 		document.body.style.color           = "black"
  872. 		document.body.style.filter          = "none"
  873. 		For Each objAnchor In document.getElementsByTagName( "a" )
  874. 			objAnchor.style.color = "blue"
  875. 		Next
  876. 	End If
  877. End Sub
  878.  
  879.  
  880.  
  881.  
  882. Function IsAdmin( showMessage )
  883. 	' Based on code by Denis St-Pierre
  884. 	Dim intbuttons, intRC
  885. 	Dim wshShell
  886. 	Dim strMsg, strTitle
  887. 	IsAdmin = False
  888. 	Set wshShell = CreateObject( "WScript.Shell" )
  889.  
  890. '	On Error Resume Next
  891.  
  892. 	intRC = wshShell.Run( "CMD /C OPENFILES > NUL 2>&1", 7, True )
  893. 	If Err Then intRC = 1
  894.  
  895. 	On Error Goto 0
  896.  
  897. 	Set wshShell = Nothing
  898. 	If intRC = 0 Then
  899. 		IsAdmin = True
  900. 	Else
  901. 		If showMessage Then
  902. 			intButtons = vbOKOnly + vbInformation + vbApplicationModal
  903. 			strMsg     = "This HTA requires elevated privileges." & vbCrLf & vbCrLf _
  904. 			           & "Please run this HTA as administrator."  & vbCrLf & vbCrLf & vbCrLf & vbCrLf _
  905. 			           & "On some 64-bit systems, you may still get this message, whether running with elevated privileges or not." & vbCrLf & vbCrLf _
  906. 			           & "Usually this is caused by HTAs being incorrectly associated with the 32-bit MSHTA version (%windir%\SysWOW64\mshta.exe)." & vbCrLf & vbCrLf _
  907. 			           & "In that case, add the path to the proper (64-bit) MSHTA to this HTA's command line:" & vbCrLf & vbCrLf & vbCrLf _
  908. 			           & """%windir%\system32\mshta.exe"" """ & Self.location.pathname & """"
  909. 			strTitle   = "Elevated privileges required"
  910. 			MsgBox strMsg, intButtons, strTitle
  911. 		End If
  912. 	End If
  913. End Function
  914.  
  915.  
  916.  
  917.  
  918. Function IsNullOrEmpty( myObject )
  919. 	If IsObject( myObject ) Then
  920. 		IsNullOrEmpty = False
  921. 	ElseIf IsNull( myObject ) Then
  922. 		IsNullOrEmpty = True
  923. 	ElseIf Trim( myObject ) = "" Then
  924. 		IsNullOrEmpty = True
  925. 	Else
  926. 		IsNullOrEmpty = False
  927. 	End If
  928. End Function
  929.  
  930.  
  931.  
  932.  
  933. Sub ListInstalledVersions( myINI )
  934. 	Dim i, strKey, strVal
  935. 	gvaLatestVersions.Clear
  936. 	gvaProgVersions.Clear
  937. 	For i = 0 To gvaProgNames.Count - 1
  938. 		strKey = gvaProgNames.GetKey( i )
  939. 		strVal = GetInstalledVersion( strKey, myINI )
  940. 		If strVal = "0" And gvbSkipNotInstalled Then
  941. 			gvaHideProg.Item( strKey ) = 1
  942. 		Else
  943. 			gvaProgVersions.Item( strKey ) = strVal
  944. 		End If
  945. 	Next
  946. End Sub
  947.  
  948.  
  949.  
  950.  
  951. Sub ListLatestVersions( myINI )
  952. 	Dim i, intButtons, strKey, strMsg
  953. 	clearTimeout gvtTimer
  954. 	gvaLatestVersions.Clear
  955. 	For i = 0 To gvaProgNames.Count - 1
  956. 		strKey = gvaProgNames.GetKey( i )
  957. 		gvaLatestVersions.Item( strKey ) = GetLatestVersion( strKey, myINI )
  958. 	Next
  959. 	gvbLatestListComplete = True
  960. 	ShowProgs
  961. 	DebugMessage "Logging ended " & Now
  962. 	ButtonUpdateProgList.disabled   = False
  963. 	ButtonRescanPrograms.disabled   = False
  964. 	ButtonShowAllDownloads.disabled = False
  965. 	If gvbQuiet Then
  966. 		If gvbUpdatesFound Then
  967. 			strMsg = "Updates are available for download."
  968. 			intButtons = vbOKOnly + vbInformation + vbSystemModal
  969. 			If gviPID = 0 Then
  970. 				strMsg = strMsg & vbCrLf & vbCrLf & "Restore the UpdateCheck window to view the details."
  971. 				MsgBox strMsg, intButtons, "UpdateCheck results"
  972. 			Else
  973. 				MsgBox strMsg, intButtons, "UpdateCheck results"
  974. 				Maximize
  975. 			End If
  976. 		Else
  977. 			Self.window.close
  978. 			Exit Sub
  979. 		End If
  980. 	End If
  981. End Sub
  982.  
  983.  
  984.  
  985.  
  986. Sub ListProgs( myINI )
  987. 	Dim objFSO, objFile, objMatches, objMatch, objRE
  988. 	Dim strAllINIText, strCustomEntry, strDebug, strDownloadReg, strHideProg, strIgnoreDots, strProgID, strProgName
  989. 	Const ForReading = 1
  990. 	strAllINIText = ""
  991. 	Set objFSO  = CreateObject( "Scripting.FileSystemObject" )
  992. 	strDebug = "<h1>* * * PART II: LOCAL INVENTORY * * *</h1>"                 & vbCrLf & vbCrLf _
  993. 	         & "Looking for INI file """ & objFSO.GetAbsolutePathName( myINI ) &  """"  & vbCrLf
  994. 	If objFSO.FileExists( myINI ) Then
  995. '		On Error Resume Next
  996.  
  997. 		Set objFile = objFSO.OpenTextFile( myINI, ForReading, False )
  998. 		If Err Then
  999. 			strDebug = strDebug & "Unable to open INI file" & vbCrLf
  1000. 			MsgBox "Unable to open file """ & objFSO.GetAbsolutePathName( myINI ) & """", vbOKOnly + vbExclamation + vbApplicationModal, "File read error"
  1001. 		Else
  1002. 			strAllINIText = objFile.ReadAll( )
  1003. 			objFile.Close
  1004. 			strDebug = strDebug & "OK (" & Len( strAllINIText ) & " bytes read)" & vbCrLf
  1005. 		End If
  1006.  
  1007. 		On Error Goto 0
  1008.  
  1009. 		Set objFile = Nothing
  1010. 		Set objFSO  = Nothing
  1011. 	Else
  1012. 		strDebug = strDebug & "Unable to open INI file" & vbCrLf
  1013. 		DebugMessage strDebug
  1014. 		MsgBox "Unable to open file """ & objFSO.GetAbsolutePathName( myINI ) & """", vbOKOnly + vbExclamation + vbApplicationModal, "File not found"
  1015. 		Set objFSO = Nothing
  1016. 		Exit Sub
  1017. 	End If
  1018. 	DebugMessage strDebug
  1019. 	Set objRE = New RegExp
  1020. 	objRE.Global     = True
  1021. 	objRE.IgnoreCase = False
  1022. 	objRE.Pattern    = "(?:^|\n|\r)\[([^\n\r\]]+)\](?:\n|\r|$)"
  1023. 	strDebug = "Listing Program IDs using the regex pattern """ & Escape( objRE.Pattern ) & """" & vbCrLf
  1024. 	Set objMatches = objRE.Execute( strAllINIText )
  1025. 	If objMatches.Count = 0 Then
  1026. 		strDebug = strDebug & "No matches"
  1027. 	Else
  1028. 		strDebug = strDebug & objMatches.Count & " match(es)"
  1029. 		gvaHideProg.Clear( )
  1030. 		gvaLatestVersions.Clear( )
  1031. 		gvaProgNames.Clear( )
  1032. 		gvaProgVersions.Clear( )
  1033. 		gvaDownloadReg.Item( "UpdateCheckHTA" ) = ""
  1034. 		gvaHideProg.Item( "UpdateCheckHTA" )    = ""
  1035. 		gvaIgnoreDots.Item( "UpdateCheckHTA" )  = ""
  1036. 		gvaProgNames.Item( "UpdateCheckHTA" )   = "UpdateCheck (this HTA)"
  1037. 		For Each objMatch In objMatches
  1038. 			strProgID      = objMatch.Submatches(0)
  1039. 			strCustomEntry = ReadINI( myINI, strProgID, "CustomEntry" )
  1040. 			strDownloadReg = ReadINI( myINI, strProgID, "DownloadRegistered" )
  1041. 			strHideProg    = ReadINI( myINI, strProgID, "HideProg" )
  1042. 			strIgnoreDots  = ReadINI( myINI, strProgID, "IgnoreDots" )
  1043. 			strProgName    = ReadINI( myINI, strProgID, "ProgName" )
  1044. 			If strCustomEntry <> "" Then gvbCustomEntries = True
  1045. 			gvaCustomEntries.Item( strProgID ) = strCustomEntry
  1046. 			gvaDownloadReg.Item( strProgID )   = strDownloadReg
  1047. 			gvaHideProg.Item( strProgID )      = strHideProg
  1048. 			gvaIgnoreDots.Item( strProgID )    = strIgnoreDots
  1049. 			gvaProgNames.Item( strProgID )     = strProgName
  1050. 		Next
  1051. 		If Not gvaProgNames.ContainsKey( "UpdateCheckINI" ) Then
  1052. 			gvaDownloadReg.Item( "UpdateCheckINI" ) = ""
  1053. 			gvaHideProg.Item( "UpdateCheckINI" )    = ""
  1054. 			gvaIgnoreDots.Item( "UpdateCheckINI" )  = ""
  1055. 			gvaProgNames.Item( "UpdateCheckINI" )   = "UpdateCheck (Program List)"
  1056. 			strDebug = strDebug & vbCrLf & vbCrLf & "Adding missing entry for UpdateCheck Program List . . ."
  1057. 		End If
  1058. 	End If
  1059. 	Set objMatches = Nothing
  1060. 	Set objRE      = Nothing
  1061. 	strDebug = strDebug & vbCrLf & vbCrLf & DebugProgList( )
  1062. 	DebugMessage strDebug
  1063. End Sub
  1064.  
  1065.  
  1066.  
  1067.  
  1068. Function Max( num1, num2 )
  1069. 	If num1 > num2 Then
  1070. 		Max = num1
  1071. 	Else
  1072. 		Max = num2
  1073. 	End If
  1074. End Function
  1075.  
  1076.  
  1077.  
  1078.  
  1079. Sub Maximize( )
  1080. 	' Based on code by Alan Kaplan
  1081. 	' http://www.akaplan.com/blog/2010/06/how-to-maximize-a-minimized-hta-file/
  1082. 	Dim wshShell
  1083. 	If gviPID > 0 Then
  1084. 		Set wshShell = CreateObject( "Wscript.Shell" )
  1085. 		wshShell.AppActivate gviPID
  1086. 		wshShell.SendKeys  "+(%" & Space(1) & "r)"
  1087. 	End If
  1088. 	Set wshShell = Nothing
  1089. End Sub
  1090.  
  1091.  
  1092.  
  1093.  
  1094. Function Min( num1, num2 )
  1095. 	If num1 < num2 Then
  1096. 		Min = num1
  1097. 	Else
  1098. 		Min = num2
  1099. 	End If
  1100. End Function
  1101.  
  1102.  
  1103.  
  1104.  
  1105. Function Pad( myString, myLength )
  1106. 	Dim strPadded
  1107. 	strPadded = myString & Space( myLength )
  1108. 	strPadded = Left( strPadded, myLength )
  1109. 	Pad = strPadded
  1110. End Function
  1111.  
  1112.  
  1113.  
  1114.  
  1115. Function ReadINI( myINI, mySection, myKey )
  1116. 	Dim objFSO, objFile, objMatches, objRE
  1117. 	Dim strAllINIText, strPattern, strValue
  1118. 	ReadINI  = ""
  1119. 	strValue = ""
  1120. 	Set objFSO  = CreateObject( "Scripting.FileSystemObject" )
  1121. 	Set objFile = objFSO.OpenTextFile( myINI, ForReading, False )
  1122. 	strAllINIText = objFile.ReadAll( )
  1123. 	objFile.Close
  1124. 	Set objFile = Nothing
  1125. 	Set objFSO  = Nothing
  1126. 	Set objRE   = New RegExp
  1127. 	objRE.Global     = True
  1128. 	objRE.IgnoreCase = True
  1129. 	objRE.Pattern    = "\[" & mySection & "\]"
  1130. 	If objRE.Test( strAllINIText ) Then
  1131. 		objRE.Pattern    = "\[" & mySection & "\][\n\r]+(?:[^\n\r=]+=[^\n\r]*[\n\r]+)*?" & myKey & "=([^\n\r]*)(?:\n|\r|$)"
  1132. 		Set objMatches = objRE.Execute( strAllINIText )
  1133. 		If objMatches.Count > 0 Then
  1134. 			strValue = Strip( objMatches.Item(0).SubMatches(0) )
  1135. 		End If
  1136. 		Set objMatches = Nothing
  1137. 		Set objRE      = Nothing
  1138. 	End If
  1139. 	ReadINI = strValue
  1140. End Function
  1141.  
  1142.  
  1143.  
  1144.  
  1145. Function ReadRegKeysNumeric( myRegPath )
  1146. 	' myRegPath specified as "{HIVE}\{REGPATH}\*" (* = literal asterisk)
  1147. 	' e.g. "HKEY_LOCAL_MACHINE\SOFTWARE\GPL Ghostscript\*"
  1148. 	Dim arrRegPath, arrSubKeys, arrTest1, arrTest2
  1149. 	Dim i, j
  1150. 	Dim objRE, objReg
  1151. 	Dim strHive, strNum, strRegPath
  1152.  
  1153. 	ReadRegKeysNumeric = 0
  1154.  
  1155. 	' Split the registry path in a hive part and the rest, and check if that succeeded
  1156. 	arrRegPath = Split( myRegPath, "\", 2 )
  1157. 	If Not IsArray( arrRegPath ) Then Exit Function
  1158.     If UBound( arrRegPath ) <> 1 Then Exit Function
  1159. 	Set objRE = New RegExp
  1160. 	objRE.Global  = False
  1161. 	objRE.Pattern = "\\\*$"
  1162. 	strRegPath = objRE.Replace( arrRegPath(1), "" )
  1163. 	' Convert the hive string to a hive number
  1164. 	strHive = gvaHives.Item( arrRegPath(0) )
  1165. 	' Create a WMI registry object, or abort on failure
  1166.  
  1167. '	On Error Resume Next
  1168.  
  1169. 	Set objReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!//./root/default:StdRegProv" )
  1170. 	If Err Then
  1171. 		On Error Goto 0
  1172. 		Exit Function
  1173. 	End If
  1174.  
  1175. 	' List all subkeys, result is stored in arrSubKeys array
  1176. 	objReg.EnumKey strHive, strRegPath, arrSubKeys
  1177. 	Set objReg = Nothing
  1178. 	If Err Then
  1179. 		On Error Goto 0
  1180. 		Exit Function
  1181. 	End If
  1182.  
  1183. 	On Error Goto 0
  1184.  
  1185. 	If Not IsArray( arrSubKeys ) Then Exit Function
  1186. 	If UBound( arrSubKeys ) < 0  Then Exit Function
  1187. 	Sort arrSubKeys
  1188. 	objRE.Pattern = "^\d+(\.\d+)*$"
  1189. 	strNum = "0.0.0.0"
  1190. 	For i = 0 To UBound( arrSubKeys )
  1191. 		If objRE.Test( arrSubKeys(i) ) Then
  1192. 			arrTest1 = Split( arrSubKeys(i), "." )
  1193. 			arrTest2 = Split( strNum, "." )
  1194. 			For j = 0 To Min( UBound( arrTest1) , UBound( arrTest2 ) )
  1195. 				If arrTest1(j) > arrTest2(j) Then
  1196. 					strNum = arrSubKeys(i)
  1197. 					Exit For
  1198. 				ElseIf arrTest1(j) < arrTest2(j) Then
  1199. 					Exit For
  1200. 				End If
  1201. 			Next
  1202. 		End If
  1203. 	Next
  1204. 	ReadRegKeysNumeric = strNum
  1205. End Function
  1206.  
  1207.  
  1208.  
  1209.  
  1210. Function ReadRegKeysWithNum( myRegPath )
  1211. 	' myRegPath specified as "{HIVE}\{REGPATH}\{KEY_CONTAINING_ASTERISK}[\{OPTIONALCHILDPATH}]"
  1212. 	' e.g. "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\Opera *\DisplayVersion"
  1213. 	Dim arrRegPath, arrSubKeys, arrTest1, arrTest2
  1214. 	Dim i, j
  1215. 	Dim objMatches, objRE, objReg, wshShell
  1216. 	Dim strChildPath, strHive, strKey, strKeyNum, strNum, strRegKey, strRegPath, strSearchKey, strTest
  1217.  
  1218. 	ReadRegKeysWithNum = 0
  1219.  
  1220. 	' Split the registry path in a hive part and the rest, and check if that succeeded
  1221. 	arrRegPath = Split( myRegPath, "\", 2 )
  1222. 	If Not IsArray( arrRegPath ) Then Exit Function
  1223.     If UBound( arrRegPath ) <> 1 Then Exit Function
  1224. 	' Convert the hive string to a hive number
  1225. 	strHive = gvaHives.Item( arrRegPath(0) )
  1226. 	' Create a WMI registry object, or abort on failure
  1227.  
  1228. 	On Error Resume Next
  1229.  
  1230. 	Set objReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!//./root/default:StdRegProv" )
  1231. 	If Err Then
  1232. 		DebugMessage "Error connecting to the registry:" & vbCrLf & Err.Description
  1233. 		On Error Goto 0
  1234. 		Exit Function
  1235. 	End If
  1236.  
  1237. 	' Determine the regex pattern required, based on the location of the * in the specified Registry path
  1238. 	Set objRE = New RegExp
  1239. 	objRE.Global = False
  1240. 	If Right( arrRegPath(1), 2 ) = "\*" Then
  1241. 		strRegPath   = Left( arrRegPath(1), 1, Len( arrRegPath(1) ) - 2 )
  1242. 		strChildPath = ""
  1243. 	Else
  1244. 		'strRegPath = Replace( arrRegPath(1), "*", "(\d+(:?\.\d+)*)" )
  1245. 		strRegPath = arrRegPath(1)
  1246. 		Set objRE = New RegExp
  1247. 		objRE.Global = False
  1248. 		objRE.Pattern = "^((?:[^\*\\]*\\)*)([^\\]*\*[^\\]*)((?:\\[^\*\\]*)*)$"
  1249. 		If objRE.Test( strRegPath ) Then
  1250. 			Set objMatches = objRE.Execute( strRegPath )
  1251. 			strRegPath   = objMatches.Item(0).Submatches.Item(0)
  1252. 			strKey       = objMatches.Item(0).Submatches.Item(1)
  1253. 			strChildPath = objMatches.Item(0).Submatches.Item(2)
  1254. 		End If
  1255. 		If Right( strRegPath, 1 ) = "\" Then
  1256. 			strRegPath   = Left( strRegPath, Len( strRegPath ) - 1 )
  1257. 		End If
  1258. 	End If
  1259. 	' List all subkeys, result is stored in arrSubKeys array
  1260. 	objReg.EnumKey strHive, strRegPath, arrSubKeys
  1261. 	Set objReg = Nothing
  1262. 	If Err Then
  1263. 		DebugMessage "Error enumerating registry subkeys for """ & myRegPath & """:" & vbCrLf & Err.Description
  1264. 		On Error Goto 0
  1265. 		Exit Function
  1266. 	End If
  1267. 	Sort arrSubKeys
  1268. 	' Get the match with the highest version
  1269. 	strKey = Replace( strKey, ".", "\." )
  1270. 	strKey = Replace( strKey, "(", "\(" )
  1271. 	strKey = Replace( strKey, ")", "\)" )
  1272. 	strKey = Replace( strKey, "+", "+)" )
  1273. 	strKey = Replace( strKey, "*", "(\d+(?:\.\d+)*)" )
  1274. 	objRE.Pattern = strKey
  1275. 	strTest = "0.0.0.0"
  1276. 	For i = 0 To UBound( arrSubKeys )
  1277. 		If objRE.Test( arrSubKeys(i) ) Then
  1278. 			Set objMatches = objRE.Execute( arrSubKeys(i) )
  1279. 			strTest = CompareVersions( strTest, objMatches.Item(0).Submatches.Item(0) )
  1280. 			Set objMatches = Nothing
  1281. 		End If
  1282. 	Next
  1283. 	strKey     = Replace( strKey, "(\d+(?:\.\d+)*)", strTest )
  1284. 	strRegPath = arrRegPath(0) & "\" & strRegPath & "\" & strKey & strChildPath
  1285. 	Set wshShell = CreateObject( "Wscript.Shell" )
  1286.  
  1287. 	On Error Resume Next
  1288.  
  1289. 	strNum = wshShell.RegRead( strRegPath )
  1290. 	If Err Then
  1291. 		strNum = strTest
  1292. 		DebugMessage "Error reading RegPath """ & strRegPath & """:" & vbCrLf & Err.Description
  1293. 	End If
  1294.  
  1295. 	On Error Goto 0
  1296.  
  1297. 	Set wshShell = Nothing
  1298. 	Set objRE = Nothing
  1299. 	ReadRegKeysWithNum = strNum
  1300. End Function
  1301.  
  1302.  
  1303.  
  1304.  
  1305. Sub RescanPrograms( )
  1306. 	Self.location.reload
  1307. End Sub
  1308.  
  1309.  
  1310.  
  1311.  
  1312. Sub SaveChanges( )
  1313. 	Dim i, intAnswer, intButtons, intPrograms
  1314. 	Dim objFSO, objWriteINI, wshShell
  1315. 	Dim strCommandLine, strCustomEntry, strDisplayName, strDownloadReg, strExecutable, strExecutable2, strHideProg, strIgnoreDots
  1316. 	Dim strINIText, strMsgText, strOutputGrep, strProgID, strProgName, strPrompt, strReadINI, strRegexPattern, strRegPath, strRegPath2
  1317. 	Dim strRegVersion, strRegVersion2, strSearchPath, strTitle, strTryInstLoc, strUseProdVer, strVersion, strWebsiteDownload, strWebsiteVersion, strWGetUseIE, strWin32Product
  1318. 	Backup gvsINIFile, gvsINIFile & "." & gvsINIVersion & ".backup." & TimeStamp( )
  1319. 	If gvbUpdateProgList Then
  1320. 		strReadINI = URL_WEB_INI
  1321. 	Else
  1322. 		strReadINI = gvsINIFile
  1323. 	End If
  1324. 	DebugMessage "Read INI file """ & strReadINI & """"
  1325. 	ListProgs strReadINI
  1326. 	strINIText  = ""
  1327. 	strMsgText  = ""
  1328. 	intPrograms = 0
  1329. 	For i = 0 To gvaProgNames.Count - 1
  1330. 		strProgID = gvaProgNames.GetKey(i)
  1331. 		If strProgID = "UpdateCheck" Then
  1332. 			' Do nothing
  1333. 		ElseIf strProgID = "UpdateCheckINI" Then
  1334. 			strProgName        = gvaProgNames.Item( strProgID )
  1335. 			strVersion         = ReadINI( strReadINI, strProgID, "Version" )
  1336. 			strWebsiteDownload = ReadINI( strReadINI, strProgID, "WebsiteDownload" )
  1337. 			strWebsiteVersion  = ReadINI( strReadINI, strProgID, "WebsiteVersion" )
  1338. 			strINIText = strINIText & "[" & strProgID & "]" & vbCrLf
  1339. 			strINIText = strINIText & "ProgName="     & strProgName & vbCrLf
  1340. 			strINIText = strINIText & "Version="      & strVersion & vbCrLf
  1341. 			strINIText = strINIText & "WebsiteDownload=" & strWebsiteDownload & vbCrLf
  1342. 			strINIText = strINIText & "WebsiteVersion="  & strWebsiteVersion  & vbCrLf& vbCrLf
  1343. 		Else
  1344. 			DebugMessage "CheckBox_" & strProgID & " checked: " & document.getElementById( "CheckBox_" & strProgID ).checked
  1345. 			strProgName = gvaProgNames.Item( strProgID )
  1346. 			If document.getElementById( "CheckBox_" & strProgID ).checked Then
  1347. 				strCustomEntry     = gvaCustomEntries.Item( strProgID )
  1348. 				strDownloadReg     = gvaDownloadReg.Item( strProgID )
  1349. 				strHideProg        = gvaHideProg.Item( strProgID )
  1350. 				strIgnoreDots      = gvaIgnoreDots.Item( strProgID )
  1351. 				strCommandLine     = ReadINI( strReadINI, strProgID, "CommandLine" )
  1352. 				strDisplayName     = ReadINI( strReadINI, strProgID, "DisplayName" )
  1353. 				strExecutable      = ReadINI( strReadINI, strProgID, "Executable" )
  1354. 				strExecutable2     = ReadINI( strReadINI, strProgID, "Executable2" )
  1355. 				strOutputGrep      = ReadINI( strReadINI, strProgID, "OutputGrep" )
  1356. 				strRegexPattern    = ReadINI( strReadINI, strProgID, "RegexPattern" )
  1357. 				strRegPath         = ReadINI( strReadINI, strProgID, "RegPath" )
  1358. 				strRegPath2        = ReadINI( strReadINI, strProgID, "Regpath2" )
  1359. 				strRegVersion      = ReadINI( strReadINI, strProgID, "RegVersion" )
  1360. 				strRegVersion2     = ReadINI( strReadINI, strProgID, "RegVersion2" )
  1361. 				strSearchPath      = ReadINI( strReadINI, strProgID, "SearchPATH" )
  1362. 				strTryInstLoc      = ReadINI( strReadINI, strProgID, "TryInstallLocation" )
  1363. 				strUseProdVer      = ReadINI( strReadINI, strProgID, "UseProductVersion" )
  1364. 				strWebsiteDownload = ReadINI( strReadINI, strProgID, "WebsiteDownload" )
  1365. 				strWebsiteVersion  = ReadINI( strReadINI, strProgID, "WebsiteVersion" )
  1366. 				strWGetUseIE       = ReadINI( strReadINI, strProgID, "WGetUseIE" )
  1367. 				strWin32Product    = ReadINI( strReadINI, strProgID, "Win32Product" )
  1368. 				' Append to INI file
  1369. 				strINIText = strINIText & "[" & strProgID & "]" & vbCrLf
  1370. 				If strCommandLine <> "" Then strINIText = strINIText & "CommandLine="        & strCommandLine & vbCrLf
  1371. 				If strCustomEntry <> "" Then strINIText = strINIText & "CustomEntry="        & strCustomEntry & vbCrLf
  1372. 				If strDisplayName <> "" Then strINIText = strINIText & "DisplayName="        & strDisplayName & vbCrLf
  1373. 				If strDownloadReg <> "" Then strINIText = strINIText & "DownloadRegistered=" & strDownloadReg & vbCrLf
  1374. 				If strExecutable <> "" Then
  1375. 					strINIText = strINIText & "Executable=" & strExecutable & vbCrLf
  1376. 					If strExecutable2 <> "" Then strINIText = strINIText & "Executable2=" & strExecutable2 & vbCrLf
  1377. 				End If
  1378. 				If strHideProg   <> "" Then strINIText = strINIText & "HideProg=" & strHideProg & vbCrLf
  1379. 				If strIgnoreDots <> "" Then strINIText = strINIText & "IgnoreDots=" & strIgnoreDots & vbCrLf
  1380. 				If strOutputGrep <> "" Then strINIText = strINIText & "OutputGrep=" & strOutputGrep & vbCrLf
  1381. 				strINIText = strINIText & "ProgName="     & strProgName & vbCrLf
  1382. 				strINIText = strINIText & "RegexPattern=" & strRegexPattern & vbCrLf
  1383. 				If strRegPath <> "" Then
  1384. 					strINIText = strINIText & "RegPath=" & strRegPath & vbCrLf
  1385. 					If strRegPath2 <> "" Then strINIText = strINIText & "RegPath2=" & strRegPath2 & vbCrLf
  1386. 				End If
  1387. 				If strRegVersion <> "" Then
  1388. 					strINIText = strINIText & "RegVersion=" & strRegVersion & vbCrLf
  1389. 					If strRegVersion2 <> "" Then strINIText = strINIText & "RegVersion2=" & strRegVersion2 & vbCrLf
  1390. 				End If
  1391. 				If strSearchPath <> "" Then strINIText = strINIText & "SearchPATH="         & strSearchPath & vbCrLf
  1392. 				If strTryInstLoc <> "" Then strINIText = strINIText & "TryInstallLocation=" & strTryInstLoc & vbCrLf
  1393. 				If strUseProdVer <> "" Then strINIText = strINIText & "UseProductVersion="  & strUseProdVer & vbCrLf
  1394. 				strINIText = strINIText & "WebsiteDownload=" & strWebsiteDownload & vbCrLf
  1395. 				strINIText = strINIText & "WebsiteVersion="  & strWebsiteVersion  & vbCrLf
  1396. 				If strWGetUseIE    <> "" Then strINIText = strINIText & "WGetUseIE="    & strWGetUseIE & vbCrLf
  1397. 				If strWin32Product <> "" Then strINIText = strINIText & "Win32Product=" & strWin32Product & vbCrLf
  1398. 				strINIText = strINIText & vbCrLf
  1399. 			Else
  1400. 				intPrograms = intPrograms + 1
  1401. 				strMsgText  = strMsgText & strProgName & vbCrLf
  1402. 			End If
  1403. 		End If
  1404. 	Next
  1405. 	If intPrograms > 0 Then
  1406. 		If intPrograms = 1 Then
  1407. 			strPrompt  = strMsgText & " will be removed from the list"
  1408. 		Else
  1409. 			strPrompt  = "The following " & intPrograms & " programs will be removed from the list:" & vbCrLf & vbCrLf & strMsgText
  1410. 		End If
  1411. 		strTitle   = "Confirm Removal"
  1412. 		intButtons = vbOKCancel + vbExclamation + vbApplicationModal + vbDefaultButton2
  1413. 		intAnswer  = MsgBox( strPrompt, intButtons, strTitle )
  1414. 		If intAnswer = vbOK Then
  1415. 			Set objFSO      = CreateObject( "Scripting.FileSystemObject" )
  1416. 			Set objWriteINI = objFSO.OpenTextFile( gvsINIFile, ForWriting, True, TristateFalse )
  1417. 			objWriteINI.Write strINIText
  1418. 			objWriteINI.Close
  1419. 			Set objWriteINI = Nothing
  1420. 			Set objFSO      = Nothing
  1421. 		End If
  1422. 	End If
  1423. 	gvbChanged = False
  1424. 	Self.location.reload
  1425. End Sub
  1426.  
  1427.  
  1428.  
  1429.  
  1430. Sub SaveCustomEntries( )
  1431. 	Dim i
  1432. 	Dim objFSO, objCustomINI
  1433. 	Dim strCommandLine, strCustomEntry, strDisplayName, strDownloadReg, strExecutable, strExecutable2, strHideProg, strIgnoreDots
  1434. 	Dim strCustomINI, strINIText, strOutputGrep, strProgID, strProgName, strRegexPattern, strRegPath, strRegPath2
  1435. 	Dim strRegVersion, strRegVersion2, strSearchPath, strTryInstLoc, strUseProdVer, strWebsiteDownload, strWebsiteVersion, strWGetUseIE, strWin32Product
  1436. 	Backup gvsINIFile, gvsINIFile & "." & gvsINIVersion & ".backup." & TimeStamp( )
  1437. 	ListProgs gvsINIFile
  1438. 	strINIText = ""
  1439. 	For i = 0 To gvaProgNames.Count - 1
  1440. 		strProgID = gvaProgNames.GetKey(i)
  1441. 		If strProgID <> "UpdateCheck" Then
  1442. 			DebugMessage "CheckBox_" & strProgID & " checked: " & document.getElementById( "CheckBox_" & strProgID ).checked
  1443. 			strCustomEntry = gvaCustomEntries.Item( strProgID )
  1444. 			If strCustomEntry <> "" Then
  1445. 				strDownloadReg     = gvaDownloadReg.Item( strProgID )
  1446. 				strHideProg        = gvaHideProg.Item( strProgID )
  1447. 				strIgnoreDots      = gvaIgnoreDots.Item( strProgID )
  1448. 				strProgName        = gvaProgNames.Item( strProgID )
  1449. 				strCommandLine     = ReadINI( gvsINIFile, strProgID, "CommandLine" )
  1450. 				strDisplayName     = ReadINI( gvsINIFile, strProgID, "DisplayName" )
  1451. 				strExecutable      = ReadINI( gvsINIFile, strProgID, "Executable" )
  1452. 				strExecutable2     = ReadINI( gvsINIFile, strProgID, "Executable2" )
  1453. 				strOutputGrep      = ReadINI( gvsINIFile, strProgID, "OutputGrep" )
  1454. 				strRegexPattern    = ReadINI( gvsINIFile, strProgID, "RegexPattern" )
  1455. 				strRegPath         = ReadINI( gvsINIFile, strProgID, "RegPath" )
  1456. 				strRegPath2        = ReadINI( gvsINIFile, strProgID, "Regpath2" )
  1457. 				strRegVersion      = ReadINI( gvsINIFile, strProgID, "RegVersion" )
  1458. 				strRegVersion2     = ReadINI( gvsINIFile, strProgID, "RegVersion2" )
  1459. 				strSearchPath      = ReadINI( gvsINIFile, strProgID, "SearchPATH" )
  1460. 				strTryInstLoc      = ReadINI( gvsINIFile, strProgID, "TryInstallLocation" )
  1461. 				strUseProdVer      = ReadINI( gvsINIFile, strProgID, "UseProductVersion" )
  1462. 				strWebsiteDownload = ReadINI( gvsINIFile, strProgID, "WebsiteDownload" )
  1463. 				strWebsiteVersion  = ReadINI( gvsINIFile, strProgID, "WebsiteVersion" )
  1464. 				strWGetUseIE       = ReadINI( gvsINIFile, strProgID, "WGetUseIE" )
  1465. 				strWin32Product    = ReadINI( gvsINIFile, strProgID, "Win32Product" )
  1466. 				' Append to INI file
  1467. 				strINIText = strINIText & "[" & strProgID & "]" & vbCrLf
  1468. 				If strCommandLine <> "" Then strINIText = strINIText & "CommandLine="        & strCommandLine & vbCrLf
  1469. 				If strCustomEntry <> "" Then strINIText = strINIText & "CustomEntry="        & strCustomEntry & vbCrLf
  1470. 				If strDisplayName <> "" Then strINIText = strINIText & "DisplayName="        & strDisplayName & vbCrLf
  1471. 				If strDownloadReg <> "" Then strINIText = strINIText & "DownloadRegistered=" & strDownloadReg & vbCrLf
  1472. 				If strExecutable <> "" Then
  1473. 					strINIText = strINIText & "Executable=" & strExecutable & vbCrLf
  1474. 					If strExecutable2 <> "" Then strINIText = strINIText & "Executable2=" & strExecutable2 & vbCrLf
  1475. 				End If
  1476. 				If strHideProg <> "" Then strINIText = strINIText & "HideProg=" & strHideProg & vbCrLf
  1477. 				If strIgnoreDots <> "" Then strINIText = strINIText & "IgnoreDots=" & strIgnoreDots & vbCrLf
  1478. 				If strOutputGrep <> "" Then strINIText = strINIText & "OutputGrep=" & strOutputGrep & vbCrLf
  1479. 				strINIText = strINIText & "ProgName="     & strProgName & vbCrLf
  1480. 				strINIText = strINIText & "RegexPattern=" & strRegexPattern & vbCrLf
  1481. 				If strRegPath <> "" Then
  1482. 					strINIText = strINIText & "RegPath=" & strRegPath & vbCrLf
  1483. 					If strRegPath2 <> "" Then strINIText = strINIText & "RegPath2=" & strRegPath2 & vbCrLf
  1484. 				End If
  1485. 				If strRegVersion <> "" Then
  1486. 					strINIText = strINIText & "RegVersion=" & strRegVersion & vbCrLf
  1487. 					If strRegVersion2 <> "" Then strINIText = strINIText & "RegVersion2=" & strRegVersion2 & vbCrLf
  1488. 				End If
  1489. 				If strSearchPath <> "" Then strINIText = strINIText & "SearchPATH="         & strSearchPath & vbCrLf
  1490. 				If strTryInstLoc <> "" Then strINIText = strINIText & "TryInstallLocation=" & strTryInstLoc & vbCrLf
  1491. 				If strUseProdVer <> "" Then strINIText = strINIText & "UseProductVersion="  & strUseProdVer & vbCrLf
  1492. 				strINIText = strINIText & "WebsiteDownload=" & strWebsiteDownload & vbCrLf
  1493. 				strINIText = strINIText & "WebsiteVersion="  & strWebsiteVersion  & vbCrLf
  1494. 				If strWGetUseIE    <> "" Then strINIText = strINIText & "WGetUseIE="    & strWGetUseIE & vbCrLf
  1495. 				If strWin32Product <> "" Then strINIText = strINIText & "Win32Product=" & strWin32Product & vbCrLf
  1496. 				strINIText = strINIText & vbCrLf
  1497. 			End If
  1498. 		End If
  1499. 	Next
  1500. 	Set objFSO = CreateObject( "Scripting.FileSystemObject" )
  1501. 	With objFSO
  1502. 		strCustomINI = .BuildPath( .GetParentFolderName( Self.location.pathname ), .GetBaseName( Self.location.pathname ) & ".custom.ini" )
  1503. 		Backup strCustomINI, strCustomINI & "." & gvsINIVersion & ".backup." & TimeStamp( )
  1504. 		Set objCustomINI = .OpenTextFile( strCustomINI, ForWriting, True, TristateFalse )
  1505. 	End with
  1506. 	objCustomINI.Write strINIText
  1507. 	objCustomINI.Close
  1508. 	Set objCustomINI = Nothing
  1509. 	Set objFSO       = Nothing
  1510. End Sub
  1511.  
  1512.  
  1513.  
  1514.  
  1515. Sub SaveDebugLog( )
  1516. 	Dim objFSO, objLogFile
  1517. 	Dim strComputerName, strLogFile, strLogText
  1518. 	strLogText = gvoIEDebug.Document.body.innerText
  1519. 	Set objFSO = CreateObject( "Scripting.FileSystemObject" )
  1520. 	With objFSO
  1521. 		strLogFile = .BuildPath( .GetParentFolderName( Self.location.pathname ), .GetBaseName( Self.location.pathname ) & "." & gvsComputerName & "." & TimeStamp( ) & ".log" )
  1522. 		Set objLogFile = .OpenTextFile( strLogFile, ForWriting, True, TristateFalse )
  1523. 		objLogFile.Write strLogText
  1524. 		objLogFile.Close
  1525. 		Set objLogFile = Nothing
  1526. 	End With
  1527. 	Set objFSO = Nothing
  1528. End Sub
  1529.  
  1530.  
  1531.  
  1532.  
  1533. Function SearchCommandOutput( myCommandLine, myPattern )
  1534. 	Dim objExec, objMatches, objRE, wshShell
  1535. 	Dim strCmdGrep, strCmdOutput, strDebug, strVersion
  1536.  
  1537. 	DebugMessage "Trying to run the following command:" & vbCrLf & Escape( myCommandLine )
  1538. 	Set wshShell = CreateObject( "Wscript.Shell" )
  1539. 	Set objExec  = wshShell.Exec( myCommandLine )
  1540. 	strCmdOutput = objExec.StdOut.ReadAll
  1541. 	Set objExec  = Nothing
  1542. 	Set wshShell = Nothing
  1543. 	DebugMessage "Output returned by command:" & vbCrLf & Escape( strCmdOutput )
  1544.  
  1545. 	strVersion = "0"
  1546. 	If myPattern = "" Then
  1547. 		strVersion = Trim( strCmdOutput )
  1548. 	Else
  1549. 		strDebug = "Trying to find version using the following regex pattern:" & vbCrLf & Escape( myPattern ) & vbCrLf
  1550. 		Set objRE = New RegExp
  1551. 		objRE.Global  = False
  1552. 		objRE.Pattern = myPattern
  1553. 		Set objMatches = objRE.Execute( strCmdOutput )
  1554. 		If objMatches.Count = 0 Then
  1555. 			strDebug = strDebug & "No matches" & vbCrLf
  1556. 		Else
  1557. 			strDebug = strDebug & objMatches.Count & " match(es)" & vbCrLf
  1558. 			If objMatches.Item(0).Submatches.Count = 0 Then
  1559. 				strDebug = strDebug & "No submatches"
  1560. 			Else
  1561. 				strDebug   = strDebug & objMatches.Item(0).Submatches.Count & " submatch(es)"
  1562. 				strVersion = objMatches.Item(0).Submatches.Item(0)
  1563. 			End If
  1564. 		End If
  1565. 		Set objMatches = Nothing
  1566. 		Set objRE      = Nothing
  1567. 		DebugMessage strDebug
  1568. 	End If
  1569. 	SearchCommandOutput = strVersion
  1570. End Function
  1571.  
  1572.  
  1573.  
  1574.  
  1575. Function SearchDisplayName( myProg, myPattern )
  1576. 	Dim arrSubKeys
  1577. 	Dim blnMatch
  1578. 	Dim i
  1579. 	Dim objRE, objReg
  1580. 	Dim strDebug, strDisplayName, strDisplayVersion, strKeyPath, strResultName, strResultVersion
  1581.  
  1582. 	Set objRE = New RegExp
  1583. 	objRE.Pattern = myPattern
  1584. 	objRE.IgnoreCase = True
  1585.  
  1586. 	Set objReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!//./root/default:StdRegProv" )
  1587. 	strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
  1588. 	On Error Resume Next
  1589. 	objReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
  1590. 	If Err Then
  1591. 		DebugMessage "Error searching for subkeys in ""HKEY_LOCAL_MACHINE\" & strKeyPath & """:" & vbCrLf & Err.Description
  1592. 	Else
  1593. 		strDebug = "Enumerating subkeys of ""HKEY_LOCAL_MACHINE\" & strKeyPath & """:"
  1594. 		For i = 0 To UBound( arrSubKeys )
  1595. 			strDebug = strDebug & vbCrLf & "HKEY_LOCAL_MACHINE\" & strKeyPath & "\" & arrSubKeys(i)
  1596. 			objReg.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath & "\" & arrSubKeys(i), "DisplayName", strDisplayName
  1597. 			blnMatch = objRE.Test( strDisplayName )
  1598. 			If blnMatch Then
  1599. 				strDebug = strDebug & vbCrLf & vbTab & "DisplayName=" & strDisplayName
  1600. 				objReg.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath & "\" & arrSubKeys(i), "DisplayVersion", strDisplayVersion
  1601. 				strDebug = strDebug & vbCrLf & vbTab & "DisplayVersion=" & strDisplayVersion
  1602. 				strResultVersion = CompareVersions( strResultVersion, strDisplayVersion )
  1603. 				strDebug = strDebug & vbCrLf & vbTab & "Result so far: " & strResultVersion
  1604. 				'If strResultVersion = strDisplayVersion Then strResultName = strDisplayName
  1605. 			End If
  1606. 		Next
  1607. 		DebugMessage strDebug
  1608. 	End If
  1609. 	On Error Goto 0
  1610.  
  1611. 	strKeyPath = "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall"
  1612. 	On Error Resume Next
  1613. 	objReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
  1614. 	If Err Then
  1615. 		DebugMessage "Error searching for subkeys in ""HKEY_LOCAL_MACHINE\" & strKeyPath & """:" & vbCrLf & Err.Description
  1616. 	Else
  1617. 		strDebug = "Enumerating subkeys of ""HKEY_LOCAL_MACHINE\" & strKeyPath & """:"
  1618. 		For i = 0 To UBound( arrSubKeys )
  1619. 			strDebug = strDebug & vbCrLf & "HKEY_LOCAL_MACHINE\" & strKeyPath & "\" & arrSubKeys(i)
  1620. 			objReg.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath & "\" & arrSubKeys(i), "DisplayName", strDisplayName
  1621. 			blnMatch = objRE.Test( strDisplayName )
  1622. 			If blnMatch Then
  1623. 				strDebug = strDebug & vbCrLf & vbTab & "DisplayName=" & strDisplayName
  1624. 				objReg.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath & "\" & arrSubKeys(i), "DisplayVersion", strDisplayVersion
  1625. 				strDebug = strDebug & vbCrLf & vbTab & "DisplayVersion=" & strDisplayVersion
  1626. 				strResultVersion = CompareVersions( strResultVersion, strDisplayVersion )
  1627. 				strDebug = strDebug & vbCrLf & vbTab & "Result so far: " & strResultVersion
  1628. 				'If strResultVersion = strDisplayVersion Then strResultName = strDisplayName
  1629. 			End If
  1630. 		Next
  1631. 		DebugMessage strDebug
  1632. 	End If
  1633. 	On Error Goto 0
  1634.  
  1635. 	If strResultName <> "" And strResultName <> myPattern Then
  1636. 		document.getElementById( "Progname_" & myProg ).innerHTML = strResultName
  1637. 	End If
  1638.  
  1639. 	Set objReg = Nothing
  1640. 	Set objRE  = Nothing
  1641.  
  1642. 	SearchDisplayName = strResultVersion
  1643. End Function
  1644.  
  1645.  
  1646.  
  1647.  
  1648. Function SearchPATH( myProg, myExec, myUseProdVer )
  1649. 	Dim objFile, objFSO, objMatches, objRE
  1650. 	Dim strDebug, strExec, strExt, strHTAText, strVersion
  1651.  
  1652. 	strExec = Which( myExec )
  1653.  
  1654. 	Set objFSO = CreateObject( "Scripting.FileSystemObject" )
  1655.  
  1656. 	If objFSO.FileExists( strExec ) Then
  1657. 		strExt = LCase( objFSO.GetExtensionName( strExec ) )
  1658. 		If strExt = "hta" Then
  1659. 			On Error Resume Next
  1660.  
  1661. 			strDebug = "Trying to open the HTA file for reading: "
  1662. 			Set objFile = objFSO.OpenTextFile( strExec, ForReading, False, TristateFalse )
  1663. 			If Err Then
  1664. 				strDebug = strDebug & "FAILED" & vbCrLf & Err.Description
  1665. 			Else
  1666. 				strDebug = strDebug & "OK"
  1667. 			End If
  1668. 			DebugMessage strDebug
  1669. 			strDebug = "Trying to read the HTA file: "
  1670. 			strHTAText  = objFile.ReadAll( )
  1671. 			If Err Then
  1672. 				strDebug = strDebug & "FAILED" & vbCrLf & Err.Description
  1673. 			Else
  1674. 				strDebug = strDebug & "OK" & vbCrLf & Len( strHTAText ) & " bytes read"
  1675. 			End If
  1676. 			DebugMessage strDebug
  1677. 			Set objFile = Nothing
  1678.  
  1679. 			On Error Goto 0
  1680.  
  1681. 			Set objRE = New RegExp
  1682. 			objRE.Pattern    = "<HTA:APPLICATION[^>]*VERSION=""(\d[\d\.]*)"""
  1683. 			objRE.Global     = False
  1684. 			objRE.IgnoreCase = True
  1685. 			strDebug = "Trying to find HTA version using the following regex pattern:" & vbCrLf & Escape( objRE.Pattern ) & vbCrLf
  1686. 			Set objMatches = objRE.Execute( strHTAText )
  1687. 			If objMatches.Count = 0 Then
  1688. 				strDebug = strDebug & "No matches"
  1689. 			Else
  1690. 				strDebug = strDebug & objMatches.Count & " match(es)" & vbCrLf
  1691. 				If objMatches(0).Submatches.Count = 0 Then
  1692. 					strDebug = strDebug & "No submatches"
  1693. 				Else
  1694. 					strDebug = strDebug & objMatches.Item(0).Submatches.Count & " submatch(es)"
  1695. 					strVersion = objMatches.Item(0).Submatches.Item(0)
  1696. 				End If
  1697. 			End If
  1698. 			Set objMatches = Nothing
  1699. 			Set objRE      = Nothing
  1700. 			DebugMessage strDebug
  1701. 		Else
  1702. 			If myUseProdVer = "" Then
  1703. 				DebugMessage "Retrieving executable's file version . . ."
  1704. 				strVersion = GetFileVersion( strExec )
  1705. 			Else
  1706. 				DebugMessage "Retrieving executable's product version . . ."
  1707. 				strVersion = GetProductVersion( strExec )
  1708. 			End If
  1709. 		End If
  1710. 	End If
  1711.  
  1712. 	Set objFSO = Nothing
  1713.  
  1714. 	SearchPATH = strVersion
  1715. End Function
  1716.  
  1717.  
  1718.  
  1719.  
  1720. Function SearchRegPath( myProg, myRegPath, myRegPath2, myExec, myUseProdVer )
  1721. 	Dim objFSO, wshShell
  1722. 	Dim strPath, strVersion
  1723.  
  1724. 	strVersion = "0"
  1725.  
  1726. 	Set objFSO   = CreateObject( "Scripting.FileSystemObject" )
  1727. 	Set wshShell = CreateObject( "Wscript.Shell" )
  1728.  
  1729. 	On Error Resume Next
  1730.  
  1731. 	strPath = wshShell.RegRead( myRegPath )
  1732. 	DebugMessage "Result value found:" & vbCrLf & "RegPath = """ & strPath & """"
  1733. 	If Err Then
  1734. 		strPath = wshShell.RegRead( myRegPath2 )
  1735. 		DebugMessage "Result value found:" & vbCrLf & "RegPath2 = """ & strPath & """"
  1736. 	End If
  1737.  
  1738. 	On Error Goto 0
  1739.  
  1740. 	If myExec <> "" Then
  1741. 		strPath = objFSO.BuildPath( Strip( strPath ), myExec )
  1742. 		DebugMessage "Result value found:" & vbCrLf & "Executable = """ & strPath & """"
  1743. 	End If
  1744.  
  1745. 	If objFSO.FileExists( strPath ) Then
  1746. 		If myUseProdVer = "" Then
  1747. 			strVersion = GetFileVersion( strPath )
  1748. 		Else
  1749. 			strVersion = GetProductVersion( strPath )
  1750. 		End If
  1751. 	Else
  1752. 		DebugMessage "File not found: """ & strPath & """"
  1753. 	End If
  1754.  
  1755. 	Set wshShell = Nothing
  1756. 	Set objFSO   = Nothing
  1757.  
  1758. 	SearchRegPath = strVersion
  1759. End Function
  1760.  
  1761.  
  1762.  
  1763.  
  1764. Function SearchRegVersion( myProg, myRegVersion, myRegVersion2 )
  1765. 	Dim blnError, strVersion, wshShell
  1766.  
  1767. 	Set wshShell = CreateObject( "Wscript.Shell" )
  1768.  
  1769. 	blnError = False
  1770.  
  1771. 	If Right( myRegVersion, 2 ) = "\*" Then
  1772. 		' Find the numeric subkey with the highest version number
  1773. 		strVersion = ReadRegKeysNumeric( myRegVersion )
  1774. 	ElseIf InStr( myRegVersion, "*" ) Then
  1775. 		' Find the matching alphanumeric subkey with the highest version number
  1776. 		strVersion = ReadRegKeysWithNum( myRegVersion )
  1777. 	Else
  1778. 		On Error Resume Next
  1779.  
  1780. 		' Read the version directly from the registry
  1781. 		strVersion = wshShell.RegRead( myRegVersion )
  1782. 		If Err Then
  1783. 			DebugMessage "Error reading RegVersion """ & myRegVersion & """:" & vbCrLf & Err.Description
  1784. 			blnError = True
  1785. 		End If
  1786.  
  1787. 		On Error Goto 0
  1788. 	End If
  1789. 	DebugMessage "RegVersion """ & myRegVersion & """ returned """ & strVersion & """"
  1790.  
  1791. 	If blnError Or ( strVersion = "0.0.0.0" ) Or ( strVersion = "0" ) Or ( strVersion = "" ) Then
  1792. 		If myRegVersion2 <> "" Then
  1793. 			If Right( myRegVersion2, 2 ) = "\*" Then
  1794. 				' Find the numeric subkey with the highest version number
  1795. 				strVersion = ReadRegKeysNumeric( myRegVersion2 )
  1796. 			ElseIf InStr( myRegVersion2, "*" ) Then
  1797. 				' Find the matching alphanumeric subkey with the highest version number
  1798. 				strVersion = ReadRegKeysWithNum( myRegVersion2 )
  1799. 			Else
  1800. 				On Error Resume Next
  1801.  
  1802. 				' Read the version directly from the registry
  1803. 				strVersion = wshShell.RegRead( myRegVersion2 )
  1804. 				If Err Then
  1805. 					DebugMessage "Error reading RegVersion2 """ & myRegVersion2 & """:" & vbCrLf & Err.Description
  1806. 					blnError = True
  1807. 				End If
  1808.  
  1809. 				On Error Goto 0
  1810. 			End If
  1811. 			DebugMessage "RegVersion2 """ & myRegVersion2 & """ returned """ & strVersion & """"
  1812. 		End If
  1813. 	End If
  1814.  
  1815. 	Set wshShell = Nothing
  1816.  
  1817. 	SearchRegVersion = strVersion
  1818. End Function
  1819.  
  1820.  
  1821.  
  1822.  
  1823. Function SearchWMI( myProg, myWin32Product, myTryInstLoc, myExec, myUseprodVer )
  1824. 	Dim colInstances, objFSO, objInstance, objWMIService
  1825. 	Dim strDebug, strExec, strPath, strVersion
  1826.  
  1827. 	Set objFSO = CreateObject( "Scripting.FileSystemObject" )
  1828.  
  1829. 	strDebug = "Connecting to WMI: "
  1830.  
  1831. 	On Error Resume Next
  1832.  
  1833. 	Set objWMIService = GetObject( "winmgmts://./root/CIMV2" )
  1834. 	If Err Then
  1835. 		strDebug = strDebug & "FAILED" & vbCrLf & Err.Description
  1836. 	Else
  1837. 		strDebug = strDebug & "OK"
  1838. 	End If
  1839. 	DebugMessage strDebug
  1840. 	strDebug = "Querying WMI: "
  1841. 	Set colInstances  = objWMIService.ExecQuery( "SELECT * FROM Win32_Product WHERE Caption LIKE """ & myWin32Product & """" )
  1842. 	If Err Then
  1843. 		strDebug = strDebug & "FAILED" & vbCrLf & Err.Description
  1844. 	Else
  1845. 		strDebug = strDebug & "OK"
  1846. 		If colInstances.Count = 0 Then
  1847. 			strDebug = strDebug & vbCrLf & "No match found"
  1848. 		ElseIf colInstances.Count = 1 Then
  1849. 			strDebug = strDebug & vbCrLf & "1 match found: "
  1850. 			For Each objInstance In colInstances
  1851. 				strDebug = strDebug & objInstance.Caption
  1852. 			Next
  1853. 		Else
  1854. 			strDebug = strDebug & vbCrLf & colInstances.Count & " matches found:"
  1855. 			For Each objInstance In colInstances
  1856. 				strDebug = strDebug & vbCrLf & objInstance.Caption
  1857. 			Next
  1858. 		End If
  1859. 	End If
  1860.  
  1861. 	On Error Goto 0
  1862.  
  1863. 	DebugMessage strDebug
  1864.  
  1865. 	strVersion = "0.0.0.0"
  1866. 	For Each objInstance In colInstances
  1867. 		DebugMessage "Version returned """ & objInstance.Version & """" & vbCrLf & "InstallLocation returned """ & objInstance.InstallLocation & """"
  1868. 		If myTryInstLoc = "" Then
  1869. 			'MsgBox "Old version: " & strVersion & vbCrLf & "WMI found version: " & objInstance.Version & vbCrLf & "New version: " & CompareVersions( strVersion, objInstance.Version )
  1870. 			strVersion = CompareVersions( strVersion, objInstance.Version )
  1871. 		ElseIf IsNullOrEmpty( objInstance.InstallLocation ) Then
  1872. 			'MsgBox "Old version: " & strVersion & vbCrLf & "WMI found version: " & objInstance.Version & vbCrLf & "New version: " & CompareVersions( strVersion, objInstance.Version )
  1873. 			strVersion = CompareVersions( strVersion, objInstance.Version )
  1874. 		ElseIf myExec <> "" Then
  1875. 			strExec = objFSO.BuildPath( objInstance.InstallLocation, myExec )
  1876. 			DebugMessage "InstallLocation combined with Executable returned """ & strExec & """"
  1877. 			If objFSO.FileExists( strExec ) Then
  1878. 				If myUseprodVer = "" Then
  1879. 					'MsgBox "Old version: " & strVersion & vbCrLf & "File version: " & objInstance.Version & vbCrLf & "New version: " & CompareVersions( strVersion, GetFileVersion( strExec ) )
  1880. 					strVersion = CompareVersions( strVersion, GetFileVersion( strExec ) )
  1881. 					DebugMessage "File version returned """ & GetFileVersion( strExec ) & """"
  1882. 				Else
  1883. 					'MsgBox "Old version: " & strVersion & vbCrLf & "Product version: " & objInstance.Version & vbCrLf & "New version: " & CompareVersions( strVersion, GetProductVersion( strExec ) )
  1884. 					strVersion = CompareVersions( strVersion, GetProductVersion( strExec ) )
  1885. 					DebugMessage "File version returned """ & GetProductVersion( strExec ) & """"
  1886. 				End If
  1887. 			Else
  1888. 				DebugMessage "File not found"
  1889. 			End If
  1890. 		Else
  1891. 			DebugMessage "Unable to retrieve program version"
  1892. 		End If
  1893. 		' Replace ASCII characters 255 by spaces
  1894. 		gvaProgNames.Item( myProg ) = Replace( objInstance.Name, Chr(255), " " )
  1895. 		document.getElementById( "ProgName_" & myProg ).innerHTML = gvaProgNames.Item( myProg )
  1896. 	Next
  1897. 	If strVersion = "0.0.0.0" Then strVersion = "0"
  1898.  
  1899. 	Set colInstances  = Nothing
  1900. 	Set objWMIService = Nothing
  1901. 	Set objFSO        = Nothing
  1902.  
  1903. 	SearchWMI = strVersion
  1904. End Function
  1905.  
  1906.  
  1907.  
  1908.  
  1909. Sub ShowAllDownloads( )
  1910. 	ButtonShowAllDownloads.disabled = True
  1911. 	gvbForceCheck = True
  1912. 	ShowProgs
  1913. End Sub
  1914.  
  1915.  
  1916.  
  1917.  
  1918. Sub ShowProgs( )
  1919. 	Dim arrLatestVersion, arrProgVersion
  1920. 	Dim blnDownGrade, blnHideProg, blnVersionMatch
  1921. 	Dim i, intMinLength, j
  1922. 	Dim objRE
  1923. 	Dim strDebug, strLatestVersion, strProgID, strProgVersion
  1924. 	For i = 0 To gvaProgNames.Count - 1
  1925. 		strProgID = gvaProgNames.GetKey(i)
  1926. 		blnHideProg  = CBool( gvaHideProg.Item( strProgID ) <> "" )
  1927. 		If strProgID = "UpdateCheckHTA" Or strProgID = "UpdateCheckINI" Then blnHideProg = False
  1928. 		' Uncheck if excluded in INI file
  1929. 		document.getElementById( "CheckBox_" & strProgID ).checked = Not blnHideProg
  1930. 		If blnHideprog Then
  1931. 			DebugMessage "Hiding <b>""" & gvaProgNames.Item( strProgID ) & """</b>"
  1932. 		Else
  1933. 			blnVersionMatch  = True
  1934. 			strLatestVersion = gvaLatestVersions.Item( strProgID )
  1935. 			strProgVersion   = gvaProgVersions.Item( strProgID )
  1936. 			strDebug = "Preparing display of results for <b>""" & gvaProgNames.Item( strProgID ) & """</b>:" & vbCrLf
  1937. 			' Uncheck if not installed
  1938. 			If strProgVersion = "0" Then
  1939. 				document.getElementById( "CheckBox_" & strProgID ).checked = False
  1940. 				ButtonSaveChanges.disabled = False
  1941. 				gvbChanged = True
  1942. 				document.getElementById( "InstalledVersion_" & strProgID ).innerHTML = "Not Installed"
  1943. 				If gvbSkipWMI Then
  1944. 					strDebug = strDebug & "Program not installed, not found or skipped." & vbCrLf & "Uncheck checkbox." & vbCrLf
  1945. 				Else
  1946. 					strDebug = strDebug & "Program not installed or not found." & vbCrLf & "Uncheck checkbox." & vbCrLf
  1947. 				End If
  1948. 				If gvbForceCheck Then
  1949. 					document.getElementById( "LatestVersion_"    & strProgID ).innerHTML = strLatestVersion
  1950. 					strDebug = strDebug & "Show all downloads selected, listing latest version." & vbCrLf
  1951. 				Else
  1952. 					document.getElementById( "LatestVersion_"    & strProgID ).innerHTML = ""
  1953. 					strDebug = strDebug & "Skip latest version." & vbCrLf
  1954. 				End If
  1955. 			Else
  1956. 				document.getElementById( "InstalledVersion_" & strProgID ).innerHTML = strProgVersion
  1957. 				strDebug = strDebug & "Display installed version: " & strProgVersion & vbCrLf
  1958. 				If strLatestVersion = "0" Then
  1959. 					document.getElementById( "LatestVersion_"    & strProgID ).innerHTML = "Not Found"
  1960. 					strDebug = strDebug & "Latest version could not be found." & vbCrLf
  1961. 				Else
  1962. 					document.getElementById( "LatestVersion_"    & strProgID ).innerHTML = strLatestVersion
  1963. 					strDebug = strDebug & "Display latest version: " & strLatestVersion & vbCrLf
  1964. 				End If
  1965. 			End If
  1966. 			If strProgVersion <> "0" And strLatestVersion <> "0" Then
  1967. 				strDebug = strDebug & "Starting version comparison." & vbCrLf
  1968. 				If gvaIgnoreDots.Item( strProgID ) = "" Then
  1969. 					intMinLength = Min( Len( gvaLatestVersions.Item( strProgID ) ), Len( gvaProgVersions.Item( strProgID ) ) )
  1970. 					If Left( gvaLatestVersions.Item( strProgID ), intMinLength ) <> Left( gvaProgVersions.Item( strProgID ), intMinLength ) Then
  1971. 						blnVersionMatch = False
  1972. 						strDebug = strDebug & "Sorry, no match yet." & vbCrLf
  1973. 					End If
  1974. 				Else
  1975. 					strDebug = strDebug _
  1976. 					         & "IgnoreDots = """ & gvaIgnoreDots.Item( strProgID ) & """, so remove dots from version numbers." & vbCrLf _
  1977. 					         & "Compare """ & Replace( gvaProgVersions.Item( strProgID ), ".", "" ) & """ (installed) against """ & Replace( gvaLatestVersions.Item( strProgID ), ".", "" ) & """ (latest)" & vbCrLf
  1978. 					intMinLength = Min( Len( Replace( gvaLatestVersions.Item( strProgID ), ".", "" ) ), Len( Replace( gvaProgVersions.Item( strProgID ), ".", "" ) ) )
  1979. 					If Left( Replace( gvaLatestVersions.Item( strProgID ), ".", "" ), intMinLength ) <> Left( Replace( gvaProgVersions.Item( strProgID ), ".", "" ), intMinLength ) Then
  1980. 						blnVersionMatch = False
  1981. 						strDebug = strDebug & "Sorry, no match yet." & vbCrLf
  1982. 					End If
  1983. 				End If
  1984. 			End If
  1985. 			' Try again after removing leading zeros and/or dots
  1986. 			If Not blnVersionMatch Then
  1987. 				Set objRE = New RegExp
  1988. 				objRE.Global = True
  1989. 				objRE.Pattern = "(?:\.|^)0+([^\.])"
  1990. 				strDebug = strDebug _
  1991. 				         & "Remove leading zeros." & vbCrLf _
  1992. 				         & "Installed version : """ & strProgVersion   & """ => """ & objRE.Replace( strProgVersion,     ".$1" ) & """" & vbCrLf _
  1993. 				         & "Latest version    : """ & strLatestVersion & """ => """ & objRE.Replace( strLatestVersion,   ".$1" ) & """" & vbCrLf _
  1994. 				         & "Now try again." & vbCrLf
  1995. 				strLatestVersion = objRE.Replace( strLatestVersion, ".$1" )
  1996. 				strProgVersion   = objRE.Replace( strProgVersion,   ".$1" )
  1997. 				arrLatestVersion = Split( strLatestVersion, "." )
  1998. 				arrProgVersion   = Split( strProgVersion,   "." )
  1999. 				intMinLength     = Min( UBound( arrLatestVersion ), UBound( arrProgVersion ) )
  2000. 				blnVersionMatch  = True
  2001. 				If gvaIgnoreDots.Item( strProgID ) = "" Then
  2002. 					For j = 0 To intMinLength
  2003. 						If arrProgVersion(j) = arrLatestVersion(j) Then
  2004. 							strDebug = strDebug & "Digits #" & CStr( j + 1 ) & " match." & vbCrLf
  2005. 						Else
  2006. 							strDebug = strDebug & "Mismatch of digits #" & CStr( j + 1 ) & "." & vbCrLf
  2007. 							blnVersionMatch = False
  2008. 							Exit For
  2009. 						End If
  2010. 					Next
  2011. 				Else
  2012. 					strLatestVersion = Join( arrLatestVersion, "" )
  2013. 					strProgVersion   = Join( arrProgVersion,   "" )
  2014. 					intMinLength     = Min( Len( strLatestVersion ), Len( strProgVersion ) )
  2015. 					strDebug = strDebug _
  2016. 					         & "IgnoreDots = """ & gvaIgnoreDots.Item( strProgID ) & """, so remove dots from version numbers." & vbCrLf _
  2017. 					         & "Compare """ & strProgVersion & """ (installed) against """ & strLatestVersion & """ (latest)" & vbCrLf
  2018. 					If Left( strLatestVersion, intMinLength ) <> Left( strProgVersion, intMinLength ) Then
  2019. 						blnVersionMatch = False
  2020. 					End If
  2021. 				End If
  2022. 			End If
  2023. 			blnDownGrade = False
  2024. 			If blnVersionMatch Then
  2025. 				If strProgVersion = "0" Then
  2026. 					strDebug = strDebug & "Not tested." & vbCrLf
  2027. 				Else
  2028. 					strDebug = strDebug & "We have a match." & vbCrLf
  2029. 				End If
  2030. 			Else
  2031. 				blnDownGrade = InStr( strProgVersion, CompareVersions( strProgVersion, strLatestVersion ) )
  2032. 				If blnDownGrade Then
  2033. 					strDebug = strDebug & "Sorry, no match, but a downgrade instead." & vbCrLf
  2034. 				Else
  2035. 					strDebug = strDebug & "Sorry, no match." & vbCrLf
  2036. 				End If
  2037. 			End If
  2038. 			If ( blnVersionMatch Or ( gvbSkipDowngrades And blnDownGrade ) And Not gvbForceCheck ) Then
  2039. 				document.getElementById( "VersionMatch_" & strProgID ).innerHTML = ""
  2040. 			Else
  2041. 				document.getElementById( "VersionMatch_" & strProgID ).innerHTML = "<input type=""button"" id=""ButtonDownload_" & strProgID & """ value=""Download"" onclick=""DownloadProgUpdate('" & strProgID & "')"">"
  2042. 			End If
  2043. 			If strLatestVersion = "0" Then
  2044. 				document.getElementById( "VersionMatch_" & strProgID ).innerHTML = "<input type=""button"" id=""ButtonDownload_" & strProgID & """ value=""Check"" onclick=""CheckProgUpdate('" & strProgID & "')"">"
  2045. 			End If
  2046. 			If strProgVersion = "0" Then
  2047. 				document.getElementById( "VersionMatch_" & strProgID ).innerHTML = "<input type=""button"" id=""ButtonDownload_" & strProgID & """ value=""Download"" onclick=""DownloadProgUpdate('" & strProgID & "')"">"
  2048. 			End If
  2049. 			If gvbForceCheck Or Not blnVersionMatch Then
  2050. 				If strProgID = "UpdateCheckHTA" Then
  2051. 					document.getElementById( "VersionMatch_UpdateCheckHTA" ).innerHTML = "<input type=""button"" id=""ButtonDownload_UpdateCheckHTA"" value=""Install"" onclick=""UpdateHTA"">"
  2052. 				End If
  2053. 				If strProgID = "UpdateCheckINI" Then
  2054. 					document.getElementById( "VersionMatch_UpdateCheckINI" ).innerHTML = "<input type=""button"" id=""ButtonDownload_UpdateCheckINI"" value=""Update"" onclick=""UpdateProgList"">"
  2055. 				End If
  2056. 			End If
  2057. 			If Not blnVersionMatch Then gvbUpdatesFound = True
  2058. 			If gvbLatestListComplete Then DebugMessage strDebug
  2059. 		End If
  2060. 	Next
  2061. End Sub
  2062.  
  2063.  
  2064.  
  2065.  
  2066. Sub Sort( ByRef myArray )
  2067. 	Dim i, j, strHolder
  2068. 	For i = ( UBound( myArray ) - 1 ) to 0 Step -1
  2069. 		For j= 0 to i
  2070. 			If UCase( myArray( j ) ) > UCase( myArray( j + 1 ) ) Then
  2071. 				strHolder        = myArray( j + 1 )
  2072. 				myArray( j + 1 ) = myArray( j )
  2073. 				myArray( j )     = strHolder
  2074. 			End If
  2075. 		Next
  2076. 	Next 
  2077. End Sub
  2078.  
  2079.  
  2080.  
  2081.  
  2082. Function Strip( myString )
  2083. 	Dim strString
  2084. 	strString = Trim( myString )
  2085. 	Do While Left( strString, 1 ) = " " Or Left( strString, 1 ) = Chr(9) Or Left( strString, 1 ) = """" Or Left( strString, 1 ) = "[" Or Left( strString, 1 ) = vbCr Or Left( strString, 1 ) = vbLf
  2086. 		strString = Mid( strString, 2 )
  2087. 	Loop
  2088. 	Do While Right( strString, 1 ) = " " Or Right( strString, 1 ) = Chr(9) Or Right( strString, 1 ) = """" Or Right( strString, 1 ) = "]" Or Right( strString, 1 ) = vbCr Or Right( strString, 1 ) = vbLf
  2089. 		strString = Mid( strString, 1, Len( strString ) - 1 )
  2090. 	Loop
  2091. 	Strip = strString
  2092. End Function
  2093.  
  2094.  
  2095.  
  2096.  
  2097. Function TextFromHTML( myURL )
  2098.     Dim objHTTP
  2099.     TextFromHTML = ""
  2100.  
  2101. '    On Error Resume Next
  2102.  
  2103.     Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
  2104.     objHTTP.Open "GET", myURL
  2105.     objHTTP.Send
  2106.     ' Check if the result was valid, and if so return the result
  2107.     If objHTTP.Status = 200 Then
  2108.     	TextFromHTML = objHTTP.ResponseText
  2109.     End If
  2110.     Set objHTTP = Nothing
  2111.  
  2112.     On Error Goto 0
  2113. End Function
  2114.  
  2115.  
  2116.  
  2117.  
  2118. Function TimeStamp( )
  2119. 	' Return current date and time in yyyyMMddhhmmss format
  2120. 	TimeStamp = Year( Now ) & Right( "0" & Month( Now ), 2 ) & Right( "0" & Day( Now ), 2 ) & Right( "0" & Hour( Now ), 2 ) & Right( "0" & Minute( Now ), 2 ) & Right( "0" & Second( Now ), 2 )
  2121. End Function
  2122.  
  2123.  
  2124.  
  2125.  
  2126. Sub UpdateHTA( )
  2127. 	Dim objFSO
  2128. 	' Delete existing ZIP file
  2129. 	Set objFSO = CreateObject( "Scripting.FileSystemObject" )
  2130. 	If objFSO.FileExists( gvsZIPFile ) Then objFSO.DeleteFile gvsZIPFile, True
  2131. 	Set objFSO = Nothing
  2132. 	' Backup current HTA
  2133. 	Backup Self.location.pathname, Self.location.pathname & "." & UpdateCheck.Version & ".backup." & TimeStamp( )
  2134. 	If Download( URL_DOWNLOAD_ZIP, gvsZIPFile ) > 10000 Then
  2135. 		' Overwrite current HTA with extracted new version and restart HTA
  2136. 		Extract gvsZIPFile, gvsCurDir
  2137. 		Self.location.reload
  2138. 	Else
  2139. 		' Delete corrupted ZIP file
  2140. 		If objFSO.FileExists( gvsZIPFile ) Then objFSO.DeleteFile gvsZIPFile, True
  2141. 		intButtons = vbOKOnly + vbExclamation + vbApplicationModal
  2142. 		strPrompt  = "An error occurred while trying to download ""updatecheck.zip""." _
  2143. 		           & vbCrLf & vbCrLf _
  2144. 		           & "Try again later, or contact the author if the problem persists."
  2145. 		strTitle   = "Download Error"
  2146. 		MsgBox strPrompt, intButtons, strTitle
  2147. 	End If
  2148. End Sub
  2149.  
  2150.  
  2151.  
  2152.  
  2153. Sub UpdateProgList( )
  2154. 	Dim objFSO, strWebINI, wshShell
  2155. 	ButtonUpdateProgList.disabled = True
  2156. 	ButtonSaveChanges.disabled    = False
  2157. 	Set objFSO = CreateObject( "Scripting.FileSystemObject" )
  2158. 	strWebINI  = objFSO.BuildPath( gvsCurDir, Right( URL_WEB_INI, Len( URL_WEB_INI ) - InStrRev( URL_WEB_INI, "/" ) ) )
  2159. 	Set objFSO = Nothing
  2160. 	SaveCustomEntries
  2161. 	Download URL_WEB_INI, strWebINI
  2162. 	gvsWebINIVersion = TextFromHTML( URL_LATESTVER_INI )
  2163. 	ClearTable
  2164. 	Initialize
  2165. 	ListProgs strWebINI
  2166. 	CreateTable
  2167. 	ShowProgs
  2168. 	ListInstalledVersions strWebINI
  2169. 	ShowProgs
  2170. 	gvbUpdateProgList = True
  2171. End Sub
  2172.  
  2173.  
  2174.  
  2175.  
  2176. Function Which( myProgName )
  2177. 	' This function searches the directories in the PATH for
  2178. 	' the specified program executable (name and extension)
  2179. 	Dim arrPath
  2180. 	Dim i
  2181. 	Dim objFound, objFSO, wshShell
  2182. 	Dim strFound, strTestPath
  2183. 	Set objFSO   = CreateObject( "Scripting.FileSystemObject" )
  2184. 	Set wshShell = CreateObject( "Wscript.Shell" )
  2185. 	strFound = ""
  2186. 	arrPath  = Split( wshShell.ExpandEnvironmentStrings( "%PATH%" ), ";" )
  2187. 	For i = 0 To UBound( arrPath )
  2188. 		' Skip empty directory values, caused by the PATH
  2189. 		' variable being terminated with a semicolon
  2190. 		If Trim( arrPath(i) ) <> "" Then
  2191. 			' Build a fully qualified path of the file to test for
  2192. 			strTestPath = objFSO.BuildPath( arrPath(i), myProgName )
  2193. 			' Check if that file exists
  2194. 			If objFSO.FileExists( strTestPath ) Then
  2195. 				' Create an object instance
  2196. 				Set objFound = objFSO.GetFile( strTestPath )
  2197. 				' Return the full path with proper capitalization
  2198. 				strFound = objFSO.GetAbsolutePathName( strTestPath )
  2199. 				' Clear the object instance
  2200. 				Set objFound = Nothing
  2201. 				' Abort when the first matching file is found
  2202. 				Exit For
  2203. 			End If
  2204. 		End If
  2205. 	Next
  2206. 	Set wshShell = Nothing
  2207. 	Set objFSO   = Nothing
  2208. 	DebugMessage "Result value found:" & vbCrLf & "Executable = """ & strFound & """"
  2209. 	Which = strFound
  2210. End Function
  2211.  
  2212.  
  2213.  
  2214.  
  2215. Sub Window_OnLoad
  2216. 	Initialize
  2217. 	WindowSize
  2218. 	If gvbQuiet Then MinimizeWindow.click
  2219. 	If Not IsAdmin( True ) Then
  2220. 		Self.window.close
  2221. 		Exit Sub
  2222. 	End If
  2223. 	setTimeout "GetPID", 100, "VBScript"
  2224. 	If InStr( UCase( gvsCommandLine ), "/HELP" ) Or InStr( gvsCommandLine, "/?" ) Then setTimeout "Help", 5000, "VBScript"
  2225. 	ListProgs gvsINIFile
  2226. 	CreateTable
  2227. 	ClearIECache
  2228. 	ShowProgs
  2229. 	ButtonsBlock.style.display     = "block"
  2230. 	CopyrightsNotice.style.display = "block"
  2231. 	ListInstalledVersions gvsINIFile
  2232. 	If gvbSkipNotInstalled Then
  2233. 		ClearNotInstalled
  2234. 		ClearTable
  2235. 		CreateTable
  2236. 	End If
  2237. 	ShowProgs
  2238. 	DebugMessage "<h1>* * * PART III: CHECK THE WEB FOR UPDATES * * *</h1>"
  2239. 	document.body.scrollTop = document.body.scrollTop + document.body.scrollHeight
  2240. 	gvtTimer = setTimeout( "ListLatestVersions """ & gvsINIFile & """", 100, "VBScript" )
  2241. End Sub
  2242.  
  2243.  
  2244.  
  2245.  
  2246. Sub Window_OnUnload
  2247. 	Dim intAnswer, intYNButtons, strPrompt, strTitle
  2248.  
  2249. '	On Error Resume Next
  2250.  
  2251. 	If ( gvbChanged Or gvbUpdateProgList ) And Not gvbQuiet Then
  2252. 		intYNButtons = vbYesNoCancel + vbQuestion + vbApplicationModal + vbDefaultButton2
  2253. 		strPrompt    = "Do you want to save the INI file changes?" & vbCrLf & vbCrLf & "Clicking ""Yes"" will remove all unchecked programs from the list."
  2254. 		strTitle     = "Save Changes?"
  2255. 		intAnswer    = MsgBox( strPrompt, intYNButtons, strTitle )
  2256. 		If intAnswer = vbYes Then
  2257. 			On Error Goto 0
  2258.  
  2259. 			SaveChanges
  2260.  
  2261. '			On Error Resume Next
  2262. 		End If
  2263. 	End If
  2264. 	Set gvaCustomEntries  = Nothing
  2265. 	Set gvaDownloadReg    = Nothing
  2266. 	Set gvaHideProg       = Nothing
  2267. 	Set gvaHives          = Nothing
  2268. 	Set gvaIgnoreDots     = Nothing
  2269. 	Set gvaLatestVersions = Nothing
  2270. 	Set gvaProgNames      = Nothing
  2271. 	Set gvaProgVersions   = Nothing
  2272. 	' Close IE window
  2273. 	If gvbDebug Then SaveDebugLog
  2274. 	gvoIEDebug.Quit
  2275. 	Set gvoIEDebug = Nothing
  2276.  
  2277. 	On Error Goto 0
  2278. End Sub
  2279.  
  2280.  
  2281.  
  2282.  
  2283. Sub WindowSize( )
  2284. 	Dim intH, intW, intX, intY
  2285. 	intH = Min( gviWindowHeight, window.screen.height )
  2286. 	intW = Min( gviWindowWidth,  window.screen.width  )
  2287. 	intX = Max( 0, Int( ( window.screen.width  - intW ) / 2 ) )
  2288. 	intY = Max( 0, Int( ( window.screen.height - intH ) / 2 ) )
  2289. 	window.resizeTo intW, intH
  2290. 	window.moveTo intX, intY
  2291. End Sub
  1. </script>
  2.  
  3. <body>
  4.  
  5. <!-- This hidden input works together with the JavaScript function "_minWin()" and the object "HHCtrlMinimizeWindowObject" to minimize the HTA window (e.g. use "MinimizeWindow.click" in VBScript) -->
  6. <input type="hidden" name="MinimizeWindow" id="MinimizeWindow" onclick="javascript:_jsMinWin();" />
  7.  
  8. <div class="Center">
  9.  
  10. <table id="AllProgTable" class="Left"></table>
  11.  
  12. <div id="CreditsBlock" style="display: none;">
  13.  
  14. <h1>Credits</h1>
  15.  
  16. <p><code>Download</code> subroutine based on a script found on the Thai Visa forum:<br>
  17. <a href="http://www.thaivisa.com/forum/index.php?showtopic=21832">http://www.thaivisa.com/forum/index.php?showtopic=21832</a></p>
  18.  
  19. <p><code>GetProductVersion</code> code by Maputi on StackOverflow.com:<br>
  20. <a href="http://stackoverflow.com/questions/2976734/">http://stackoverflow.com/questions/2976734/</a></p>
  21.  
  22. <p><code>Maximize</code> code by Alan Kaplan:<br>
  23. <a href="http://www.akaplan.com/blog/2010/06/how-to-maximize-a-minimized-hta-file/">http://www.akaplan.com/blog/2010/06/how-to-maximize-a-minimized-hta-file/</a></p>
  24.  
  25. <p><code>Minimize</code> window functionality by Josh D'Alessio:<br>
  26. <a href="http://quiome.blogspot.nl/2010/02/paypal-safer-easier-way-to-pay-online.html">http://quiome.blogspot.nl/2010/02/paypal-safer-easier-way-to-pay-online.html</a></p>
  27.  
  28. <p>ZIP file extraction code by Microsoft:<br>
  29. <a href="http://msdn.microsoft.com/en-us/library/ms723207.aspx">http://msdn.microsoft.com/en-us/library/ms723207.aspx</a></p>
  30.  
  31. <p><code>IsAdmin</code> code by Denis St-Pierre:<br>
  32. <a href="http://www.robvanderwoude.com/clevertricks.php#Elevated">http://www.robvanderwoude.com/clevertricks.php#Elevated</a></p>
  33.  
  34. <p>Array <code>Sort</code> code by the Scripting Guys:<br>
  35. <a href="http://www.microsoft.com/technet/scriptcenter/resources/qanda/nov04/hey1122.mspx">http://www.microsoft.com/technet/scriptcenter/resources/qanda/nov04/hey1122.mspx</a></p>
  36.  
  37. <p>Internet Explorer based debug window based on code from Don Jones' book:<br>
  38. <a href="http://astore.amazon.com/scriptingbooks-20/detail/0321501713/190-0304176-5019553">VBScript, WMI, and ADSI Unleashed: Using VBScript, WMI, and ADSI to Automate Windows Administration</a></p>
  39.  
  40. <p>Window scrolling code by C.C. White on StackOverflow.com:<br>
  41. <a href="http://stackoverflow.com/questions/5936668/vbscript-how-to-force-the-ie-scroll-bars-to-lock-to-the-bottom">http://stackoverflow.com/questions/5936668/vbscript-how-to-force-the-ie-scroll-bars-to-lock-to-the-bottom</a></p>
  42.  
  43. <p>Thanks!</p>
  44.  
  45. </div>
  46.  
  47. <p id="ButtonsBlock" style="display: none;">
  48. <input type="button" name="ButtonRescanPrograms"   id="ButtonRescanPrograms"   value="Rescan Programs"     onclick="vbscript:RescanPrograms"   disabled="disabled" title="Reload the initial (local) program list" />
  49. &nbsp;
  50. <input type="button" name="ButtonShowAllDownloads" id="ButtonShowAllDownloads" value="Show All Downloads"  onclick="vbscript:ShowAllDownloads" disabled="disabled" title="Reload the initial (local) program list" />
  51. &nbsp;
  52. <input type="button" name="ButtonHelp"             id="ButtonHelp"             value="Help"                onclick="vbscript:Help"                                 title="Show help for UpdateCheck.hta" />
  53. <br>
  54. &nbsp;
  55. <br>
  56. <input type="button" name="ButtonUpdateProgList"   id="ButtonUpdateProgList"   value="Update Program List" onclick="vbscript:UpdateProgList"   disabled="disabled" title="Get the latest program list from the web and check which programs are installed on this computer. WARNING: This will overwrite any changes YOU made to the program list (UpdateCheck.ini)!" />
  57. &nbsp;
  58. <input type="button" name="ButtonSaveChanges"      id="ButtonSaveChanges"      value="Save Changes"        onclick="vbscript:SaveChanges"      disabled="disabled" title="Save the changes and load the new program list" />
  59. &nbsp;
  60. <input type="button" name="ButtonCredits"          id="ButtonCredits"          value="Credits"             onclick="vbscript:Credits"                              title="Show credits for UpdateCheck.hta" />
  61. </p>
  62.  
  63. <p id="CopyrightsNotice" style="display: none;"></p>
  64.  
  65. </div>
  66.  
  67. </div>
  68.  
  69. </body>
  70. </html>

page last uploaded: 2017-04-06, 13:33