SmartUpdate vbs script

This has a lot of intelligence to remove outdated versions, and install the right copy of firefox. It also support an exclusion list, for systems that should not be touched.

[VBScript code]
'Program: Firefox_removeAll.vbs 
'Purpose: Remove all 'bad' instances and install a fresh copy, if needed
' Author: Roger C  11/08/2017
'  Logic: 
'			Loop through the registry to find all installed copies
'			Execute the uninstall string that we find
'           After (possible) uninstall, launch install (if needed)
' v3 add an exception list, for any systems that should not be touched.
' v2.1 adds corrective measure to rename firefox.exe.qid370658, if needed
' v.2 adds enhancement to address x64 registry issue

option explicit
Dim Version : Version = "3.0.0.0"

Dim  ExceptionList ' The list of computers that won't be touched.  =============================[ EXCEPTION LIST ]=====
 
 ExceptionList = ""

 '======================================================================================================================

 '===[ Declare variables ]===
Dim S
Dim CurrentVersion : CurrentVersion = "57.0.0.6525"    		' Only remove versions 32bit older than this version, or any 64bit version
Dim FileName       : FileName       = "firefox.exe" 		' This file is used as a reference to for the version number
Const                InstallString  = "CMD /c install.cmd" 	' The script that runs after removal, to put on the current version.  Package it into the default folder.
Const 				 VerifyPath 	= "C:\Program Files (x86)\Mozilla Firefox"
Const 				 VerifyFile 	= "Firefox.exe"

Const HKLM          = &H80000002
CONST x64_regLocation = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
CONST x86_regLocation = "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall"

'Reqired for advanced logging
Dim MaxLogFileSize 	: MaxLogFileSize 	= 10000
Dim LogFilenamePath	: LogFilenamePath 	= ".\"
Dim DisplayNameStr 	: DisplayNameStr 	= "Mozilla Firefox"
Dim objFSO			: Set objFSO 		= CreateObject("Scripting.FileSystemObject")

Dim LogFileHandle, objNetwork, ScriptUser, ScriptComputer

' This code handles 32 64 bit issues for x64 systems
' Without it, it always looks in the 32 bit wow6432node
Dim objCtx : Set objCtx = CreateObject("WbemScripting.SWbemNamedValueSet") ' create a NamedValueSet to store some extra parameters
objCtx.Add "__ProviderArchitecture", 64
objCtx.Add "__RequiredArchitecture", FALSE
Dim objLocator : Set objLocator = CreateObject("Wbemscripting.SWbemLocator")   ' create a locator object to store the WMI reference
Dim objServices : Set objServices = objLocator.ConnectServer("localhost","root\default","","","","",0,objCtx)
if not IsObject(objServices) then
	s = s & "Error=SWebmLocator.ConnectServer Failure" & vbCrlf
End If
Dim objReg : Set objReg = objServices.Get("StdRegProv")

Dim msgExit : msgExit = "--- Exiting the routine"
Dim MyErrNumber, MyErrSource, MyErrDesc
Dim UninstallWasSuccessful : UninstallWasSuccessful = VBFalse

'===[ MAIN BODY ]========================================================================
LogWriteln("Making sure this host is not an exception")
If instr(Ucase(ExceptionList),UCase(Hostname)) = 0 then    ' Check the list for exceptions, and exit if needed
	RenameQIDFile					' remove the file extension (leftover from previous efforts) - remove after 1/1/2018
	LoopThroughKeys x64_regLocation ' Loop through the uninstall keys x64
	LoopThroughKeys x86_regLocation ' Loop through the uninstall keys x86
	' if UninstallWasSuccessful then  ' If there was a successful uninstall
	if not objFSO.FileExists (VerifyPath & "\" & VerifyFile) then 
		InstallCurrentVersion		' install current version
	end if
Else	
	LogWriteln("      Whoops - we're not supposed to update this system")
End if
LogWriteln( msgExit )


'===[ subroutines ]========================================================================

Function Hostname
	DIM HName
	'LogWriteln("Get hostname") 
	objReg.GetStringValue HKLM, "SYSTEM\CurrentControlSet\Services\Tcpip\Parameters", "Hostname", HName
	LogWriteln("      Hostname: " & HName)
	Hostname = HName	
end function

Sub InstallCurrentVersion
	' Search current folder and run the setup progam that you find.
	' Example: Firefox Setup 57.0_x86
	Dim objFolder, colFiles, oFile, fname, fVersion
	
	' if there's a file that would force a reboot, delete it
	LogWriteln("Checking for file left from previous uninstall (pending reboot flag)")
	If DelFile("C:\Program Files\Mozilla Firefox\firefox.exe.moz-delete") and _
		DelFile("C:\Program Files\Mozilla Firefox\firefox.exe.moz-upgrade") and _
		DelFile("C:\Program Files (x86)\Mozilla Firefox\firefox.exe.moz-delete") and _
		DelFile("C:\Program Files (x86)\Mozilla Firefox\firefox.exe.moz-upgrade") then
		LogWriteln("OK To install new version")
		
		'' find the setup file
		'Set objFolder = objFSO.GetFolder(".")
		'Set colFiles = objFolder.Files
		'For Each oFile in colFiles
		'	fname = objFSO.GetFileName(oFile.name)
		'	If instr(UCase(fname),"SETUP") > 0 and _
		'		instr(UCase(fname),".EXE") > 0 then
		'		LogWriteln("Found: " & fname)
		'	End If
		'Next
		RunMyCommand InstallString
		if objFSO.FileExists(VerifyPath & "\" & VerifyFile) then 
			LogWriteln("      Verified file exists: " & VerifyPath & "\" & VerifyFile)
			fVersion = FileVersion(VerifyPath, VerifyFile)
			if Version_is_Lesser(fVersion, CurrentVersion) then
				LogWriteln("      Failed. File version (" & fVersion & ") is older than target version (" & CurrentVersion & ")")
			Else
				LogWriteln("      Success. The file version (" & fVersion & ") is at least as new as target version (" & CurrentVersion & ")")
			end if
		else
			LogWriteln("      Failed installation. Unable to find " & VerifyPath & "\" & VerifyFile)
		end if	
	End if
end sub

Function DelFile(F)
	if Not objFSO.FileExists(F) then 
		DelFile = vbTrue
	Else
		LogWriteln("      Attempting to delete file: " & F)
		objFSO.DeleteFile(F)
		if objFSO.FileExists(F) then 
			LogWriteln("      The attempt to delete the file failed.  Will not attempt to install new version.")
			DelFile = vbFalse
		else
			LogWriteln("      Successfully deleted")
			DelFile = vbTrue
		End if
	End if
end Function

Sub RenameQIDFile ' if found, rename the firefox.exe.qid370658 file
	on error resume next
	Dim strExeBaseName : strExeBaseName = CreateObject("WScript.Shell").ExpandEnvironmentStrings("%PROGRAMFILES%\mozilla Firefox\Firefox.exe")
	LogWriteln("Probing for undesired file: " & strExeBaseName& ".QID370658")
	if objFSO.FileExists(strExeBaseName& ".QID370658") then 
		LogWriteln("Found. Attempting to rename " & strExeBaseName& ".QID370658 to " & strExeBaseName)
		fso.MoveFile strExeBaseName& ".QID370658", strExeBaseName
		if objFSO.FileExists(strExeBaseName& ".QID370658") then 
			LogWriteln("File is found after rename. Rename failed.")
		else
			LogWriteln("File is not found after rename. Rename successful.")
		end if
	else
		LogWriteln("Good news: File is not found")
	end if
	on error goto 0
End Sub

Sub LoopThroughKeys(RegLocation)        '-------------------------------------------------------------------
	Dim i, arrSubKeys, strSubkey, strValueName
	Dim arrValueNames, arrTypes
	dim  uValue, arrValues, strValue, arrBytes, strBytes ' return values from reading regkeys
	Dim strUninstallString, strDisplayName, strInstallLocation, RunCommand
	Dim ShouldSkipThisKey
		
	LogWriteln( "Probing registry:  HKLM\" & RegLocation)
	objReg.EnumKey HKLM, RegLocation, arrSubKeys                       ' read the subkeys into an array
	For Each strSubkey In arrSubKeys                                   ' loop through each subkey found in UNINSTALL key	
		ShouldSkipThisKey = vbTrue                                     ' Assume we should skip the key unless we find it has an issue
		objReg.EnumValues HKLM, RegLocation & "\" & strSubkey, _
		arrValueNames, arrTypes		                                   ' read the subkeys for this element
		if isarray(arrValueNames) then           	                   ' if it's an array (we got usable subkey results for this software)
			objReg.GetStringValue HKLM, RegLocation & "\" & strSubkey, "DisplayName", strDisplayName ' try to read the displayname
			if not isNull(strDisplayName) then                         '   if the displayname is a valid key
				if instr(ucase(strDisplayName),ucase(DisplayNameStr)) > 0 then ' if it's a legit key
					objReg.GetStringValue HKLM, RegLocation & "\" & strSubkey, "InstallLocation", strInstallLocation ' try to read the InstallLocation
					if not isNull(strInstallLocation) then                         '   if the InstallLocation is a valid key
						objReg.GetExpandedStringValue HKLM, RegLocation & "\" & strSubkey, "UninstallString", strUninstallString ' get the uninstall info
						if not isnull(strUninstallString) then                     '     if the UninstallString is legit
							'LogWriteln(Chr(13))
							LogWriteln( "Found a candidate for removal")
							LogWriteln( "      RegLocation: HKLM\" & RegLocation & "\" & strSubkey)
							LogWriteln( "      DisplayName: " & strDisplayName)
							LogWriteln( "      InstallLocation:" & strInstallLocation)
							strUninstallString = strUninstallString  & " /S"                 'prep the uninstall string
							LogWriteln( "  UninstallString: " & strUninstallString)
							
							' if it's the x86 registry, then check version
							if RegLocation = x64_regLocation then
								LogWriteln("      64bit version found: " & strInstallLocation & "\" & FileName)
								LogWriteln("      Proceeding with uninstall of " & strDisplayName)
								ShouldSkipThisKey = vbFalse
							Else
								LogWriteln( "32bit version found: " & strInstallLocation & "\" & FileName)
								LogWriteln( "Retrieving file version: " & strInstallLocation & "\" & FileName)
								LogWriteln("      Compare File Version (" & FileVersion(strInstallLocation, FileName) & ") to desired version (" & CurrentVersion & ")")
								
								if Version_is_Lesser(FileVersion(strInstallLocation, FileName), CurrentVersion) then
									LogWriteln("      Outdated: Proceeding with uninstall of " & strDisplayName)
									ShouldSkipThisKey = vbFalse
								Else
									LogWriteln("      This is current enough.  There is no need to need to uninstall " & strDisplayName)
								end if
							end if
							
							if Not ShouldSkipThisKey then
								RunMyCommand strUninstallString   	' execute the uninstall string
								WScript.Sleep 5000 					' give it time to process the changes in the file system
								if NOT objFSO.FileExists(strInstallLocation & "\" & FileName) then   ' make sure the program is really uninstalled
									LogWriteln("Success. Verified file is gone: " & strInstallLocation & "\" & FileName)
									UninstallWasSuccessful = VBTrue
								else
									LogWriteln("Uninstall failed. File is still found: " & strInstallLocation & "\" & FileName)
								end if				
							end if
						end if
					end if
				end if
			End If			
		end if
	Next
end sub

Sub RunMyCommand(Commandline)        '-------------------------------------------------------------------
	Dim objShell

	' open to a shell for running the command, if not already done
	on error resume next 
	Set objShell = WScript.CreateObject ("WScript.Shell")
	on error goto 0
	
	If  NOT IsObject(objShell) then 
		LogWriteln("Error: unable to create Wscript.shell object. Cannot run the command [" & Commandline & "]")
	else
		LogWriteln("Created Shell object.  Run command  [" & Commandline & "]")
		MyErrDesc = ""
		on error resume next
			objShell.run Commandline,,VBTRUE ' run the command ' <-- dangerous - commented out for debugging		
			MyErrSource = Err.Source
			MyErrDesc = Err.Description
		On Error GoTo 0
		if MyErrDesc = "" then 
			LogWriteln("Completed Run Command")
		else
			LogWriteln("Something went wrong.  Source: " & MyErrSource & " | " & MyErrDesc)		
		end if
	end if
end sub

Function FileVersion(FDir, FName) 
	Dim oFileCollection,oFile, FoundFilename, FoundVer
	FoundFilename = ""
	Set oFileCollection = objFSO.GetFolder(FDir).Files
	If Err.Number  0 Then
		S = S & "Path not found " &  FDir&"\"&FName & chr(13) & chr(10)
	else
		For Each oFile in oFileCollection
			if ucase(oFile.name)= ucase(FName) then
				FoundFilename = oFile.Name
				FoundVer = objFSO.getfileversion(FDir&"\"&FoundFilename)
				If Err.Number = 0 Then
					FileVersion = FoundVer
				end if
			end if
		Next
	End if
	if FoundFilename = "" then 
		S = S & "Path/File not found " &  FDir&"\"&FName & chr(13) & chr(10)
	end if
end function

Function Version_is_Lesser(A, B)
' if first parameter is less than second, then return true, else return false
	Dim I,A_Long,B_Long,ArA,ArB
	A_Long = 0 :  B_Long = 0
	ArA = Split(A, ".",-1) : ArB = Split(B, ".",-1)
    For I = 0 to Ubound(ArA)
        A_Long =  A_Long * 10000 + ArA(I) : B_Long =  B_Long * 10000 + ArB(I)
    Next
    Version_is_Lesser = (A_Long < B_Long)
End function 'Version_is_Lesser

sub LogWriteln(s)        '-------------------------------------------------------------------
	s = "  " & TimeStamp() &  " " & s
	'wscript.echo s              'write message to the console
	if Not isObject(LogFileHandle) Then InitLogFile
	If isObject(LogFileHandle) Then 
		LogFileHandle.write s & vbCRLF
	end if 'write message to the log file
End Sub

sub InitLogFile        '-------------------------------------------------------------------
	Const Write = 2
	Const Append = 8
	Dim OpenMode : OpenMode = Write
	Dim Failed   : Failed = False
	Dim LogFilename, OldLogFilename
	LogFilename = LogFilenamePath & Replace(ucase(wscript.ScriptName),".VBS",".LOG")
	OldLogFilename = LogFilenamePath & Replace(ucase(wscript.ScriptName),".VBS",".OLD.LOG")

	if NOT (objFSO.FolderExists(LogFilenamePath)) then ' if the folder isn't there
		Set objFolder = objFSO.CreateFolder(LogFilenamePath) ' create the folder
	Else													
		On Error Resume Next ' try to open the file to check its size
		Set LogFileHandle=objFSO.GetFile(LogFilename) ' connect to the file
		MyErrNumber = err.number
		on error goto 0
		
		if isObject(LogFileHandle) and MyErrNumber = 0 then
			if LogFileHandle.Size < MaxLogFileSize then
				OpenMode = Append
			else ' if file is too big, try to roll it over to the OLD file
				on error resume next
				if objFSO.FileExists(OldLogFilename) then objFSO.DeleteFile(OldLogFilename)
				objFSO.MoveFile LogFilename, OldLogFilename
				on error goto 0
			end if	
		end if
	end if ' test whether folder exists

	Err.Clear
	On Error Resume Next
	Set LogFileHandle = objFSO.OpenTextFile(LogFilename,OpenMode,True)
	On Error goto 0
	if err.number  0 then
        Failed = True
    End If	

	Set objNetwork = CreateObject("Wscript.Network")
	ScriptUser = objNetwork.UserName
	ScriptComputer = objNetwork.ComputerName

	If Not Failed then 
		On Error Resume Next
		LogFileHandle.write( _
			"===[" & Month(DATE) & "/" & Day(DATE) & "/" & Year(DATE) & _
			"]=========[ User:" & ScriptUser & " on " & ScriptComputer & " ]=======" & vbCrlf	_
			)
		on error goto 0
	end if
End Sub

Function TimeStamp()
 Dim intSeconds, intMilliseconds
 intSeconds = (Hour(Now) * 3600) + (Minute(Now) * 60) + Second(Now)
 intMilliseconds = Timer() - intSeconds
 intMilliseconds = Fix(intMilliseconds * 100)
 TimeStamp = Hour(Now) & ":" & Right("0" & Minute(Now),2) & ":" & Right("0" & Second(Now),2) & "." & Right("0" & intMilliseconds,2)
End Function

Advertisements

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s