VB script to automate the installation, configuration and launch of Google Chrome

installChrome.vbs

' Author: Rob W <[email protected]>
' License: Creative Commons 3.0 with attribution
'    http://creativecommons.org/licenses/by/3.0/
'
' My own use case:
' For browser-testing purposes, I've set up a Win XP Virtual Machine
'   (http://stackoverflow.com/q/10541225). My Chrome installers are 
' located in a virtual share, at \\VBOXSRV\WinShared\WinXPDev\Chrome\
' When I need to test an old Chrome version, I launch this script, which
'  automatically installs and configures Chrome.
' This script is a derivate from my other script, which does a similar
'  job for Firefox/Opera. Contact me if you want that script.
'
' See also: http://stackoverflow.com/a/10917231/938089

Option Explicit

' Common objects
Dim oWShell, oFSO, oNetwork, colDrives, sWinshared, i, sDrive, sCommonDialogInitialDir
Set oWShell = CreateObject("WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")

' Get drive letter for \\vboxsrv\winshared
Set oNetwork = WScript.CreateObject("WScript.Network")
Set colDrives = oNetwork.EnumNetworkDrives
sWinshared = "\\vboxsrv\winshared"
sCommonDialogInitialDir = "\\vboxsrv\winshared\winxpdev"
For i = 0 to colDrives.Count-1 Step 2
    If (lcase(colDrives.Item(i + 1)) = sWinshared) then
        sDrive = colDrives.Item(i)
        Exit For
    End If
Next
If sDrive="" Then
    Wscript.Echo "Cannot find a drive letter for " & sWinshared
    Wscript.Quit
End If
Set oNetwork = nothing
Set colDrives = nothing

NextStep 0

Function UNCtoLocal (sPath)
    UNCtoLocal = Replace(sPath, sWinshared, sDrive, 1, 1, vbTextCompare)
End Function

Sub NextStep (iStep)
    ' If this script is invoked with an extra argument (e.g. file Drag 'n Drop), 
    '  try to process the file first
    If iStep <> 1 AND WScript.Arguments.Count > 0 Then
        ' When the arg is not a recognised installer, go to next step
        Dim sArg1
        sArg1 = WScript.Arguments.Item(0)
        If lcase(oFSO.GetExtensionName(sArg1)) <> "exe" _
         Or Not oFSO.FileExists(sArg1) _
         Or processFile(sArg1, True) <> 1  Then
            NextStep 1
        End If
    Else
        Dim oFSDialog, oIE, sFileName
        On Error Resume Next
        Set oFSDialog = CreateObject("UserAccounts.CommonDialog")
        If Err.Number = 0 Then
            On Error Goto 0
            oFSDialog.Filter = "Executables|*.exe"
            oFSDialog.FilterIndex = 1
            oFSDialog.InitialDir = UNCtoLocal(sCommonDialogInitialDir)
            If oFSDialog.ShowOpen Then
                sFileName = oFSDialog.FileName
            End If
        Else
            ' Non-XP, ugly fallback
            On Error Goto 0
            Set oIE = CreateObject("InternetExplorer.Application")
            oIE.visible = false
            oIE.Navigate("about:blank")
            Do Until oIE.ReadyState = 4
                WScript.Sleep 100
            Loop
            oIE.document.write "<input id=""fileDialog"" type=""file"">"
            With oIE.document.all.fileDialog
                .focus
                .click
                sFileName = .value
            End With
            oIE.Quit
        End If
        If sFileName = "" Then
            Wscript.Echo "No file selected!"
            Wscript.Quit 0
        Else
            processFile sFileName, False
        End If
    End If
End Sub

Sub NetStartDcomLaunch()
    oWShell.Run "net start DcomLaunch", 0, 0
    Dim oWMIService, colProcess, oProcess
    Set oWMIService = GetObject("winmgmts:\\.\root\cimv2")
    Do
        On Error Resume Next
        ' net.exe and net1.exe
        Set colProcess = oWMIService.ExecQuery("SELECT * FROM Win32_Process WHERE Name LIKE 'net' AND CommandLine LIKE 'start DComLaunch'")
        
        ' This is going to throw an error when DComLaunch is not started yet
        For Each oProcess in colProcess
            oProcess.Terminate()
        Next
        If Err.Number = 0 Then
            Exit Sub
        End If
        WScript.Sleep 1000
    Loop
End Sub

Function processFile (strFile, binSilent)
    Dim oWMIService, strFileWMI, oFile, strManufacturer
    
    ' Launch necessary service if unavailable
    NetStartDcomLaunch
    
    ' Get file information
    Set oWMIService = GetObject("winmgmts:\\.\root\cimv2")
    strFileWMI = Replace(UNCtoLocal(strFile), "\", "\\")
    Set oFile = oWMIService.Get("CIM_DataFile.Name=""" & strFileWMI & """")
    Set oWMIService = nothing
    If (oFile is nothing) then 
        WScript.echo "processFile: oFile is nothing!"
        processFile = 0
        Exit Function
    End If
    processFile = 1
    strManufacturer = oFile.Manufacturer
    ' Quick test (no warranties)
    If InStr(1, strManufacturer, "Google", vbTextCompare) Then
        InstallChrome strFile
    Else
        If Not binSilent Then
            wscript.echo "Unknown manufacurer: " & strManufacturer &_
                        vbCrLf & "File: " & strFile
        End If
        processFile = 0
        Exit Function
    End If
End Function

' -------------
'    Chrome
' -------------
Function getLastCreatedDirectory(sFolder)
    Dim oFolder, aFolder, fNewest, sNewest
    Set oFolder = oFSO.GetFolder(sFolder)
    For Each aFolder In oFolder.SubFolders
        If lcase(aFolder.Name) <> "dictionaries" Then
            If sNewest = "" Then
                Set fNewest = aFolder
                sNewest = fNewest.Name
            Else
                If fNewest.DateCreated < aFolder.DateCreated Then
                    Set fNewest = aFolder
                    sNewest = fNewest.Name
                End If
            End If
        End If
    Next
    getLastCreatedDirectory = sNewest
End Function


Sub InstallChrome(sFileName)
    sFileName = UNCtoLocal(sFileName)
    
    ' Naming convention: sDir with trailing slash, sFolder without.
    Dim SevenZip, TMP, sShortcutLnk, sDesktopLnk
    Dim sChromeMinimumVersion, sChromeVersionFull, sChromeVersionMajor
    Dim sDirChromeBin, sDirChromeBinVersion, sDirChromeMain, sDirChromeMainVersion
    Dim sDirChromeUserData, sFolderChromeUserDataDefault, sFolderChromeUserDataVersion
    Dim sChromeLaunchExe, sChromeLaunchArguments, oLaunch
    Dim choice 'for dialogs
    
    TMP = oWShell.ExpandEnvironmentStrings("%TMP%\")
    SevenZip = """C:\Program Files\7-zip\7z.exe"""
    
    sDirChromeBin = TMP & "Chrome-bin\"
    sDirChromeMain = "C:\Chrome\"
    sDirChromeUserData = sDirChromeMain & "User Data\"
    sFolderChromeUserDataDefault = sDirChromeUserData & "2"    'Settings etc copied from here
    
    ' Unpacking
    oWShell.Run SevenZip & " e -y """ & sFileName & """ -o""" & TMP & """", 1, 1
    oWShell.Run SevenZip & " x -y """ & TMP & "chrome.7z"" -o""" & TMP & """", 1, 1
    
    If oFSO.FolderExists(sDirChromeBin) Then
        sChromeVersionFull = getLastCreatedDirectory(sDirChromeBin)
        sChromeVersionMajor = Split(sChromeVersionFull, ".")(0)
        sDirChromeBinVersion = sDirChromeBin & sChromeVersionFull & "\"
        sDirChromeMainVersion = sDirChromeMain & sChromeVersionFull & "\"
        sFolderChromeUserDataVersion = sDirChromeUserData & sChromeVersionMajor
        
        If not oFSO.FolderExists(sDirChromeMain) Then
            oFSO.CreateFolder sDirChromeMain
        End If
        If oFSO.FolderExists(sDirChromeMainVersion) Then
            choice = MsgBox(_
                    sDirChromeMainVersion & "  already exists." & vbCrLf &_
                    "Do you want to overwrite the previous installation?",_
                    vbYesNo Or vbQuestion & vbApplicationModal,_
                    "Folder already exists"_
                     )
            If choice = vbNo Then
                ' CleanUp
                If oFSO.FileExists(TMP & "chrome.7z") Then
                    oFSO.DeleteFile TMP & "chrome.7z", True
                End If
                oFSO.DeleteFolder RemoveTrailingSlash(sDirChromeBin), True
                WScript.Quit
            Else
                oFSO.DeleteFolder RemoveTrailingSlash(sDirChromeMainVersion)
            End If
        End If
        If oFSO.FileExists(sDirChromeBinVersion & "chrome.exe") Then
            oFSO.DeleteFile sDirChromeBinVersion & "chrome.exe"
        End If
        
        ' Disable First Run dialog
        oFSO.OpenTextFile sDirChromeBinVersion & "First Run", 1, True
        ' Move files and folders to final destination C:\Chrome
        oFSO.MoveFile sDirChromeBin & "chrome.exe", sDirChromeBinVersion
        oFSO.MoveFolder RemoveTrailingSlash(sDirChromeBinVersion), sDirChromeMain
        
        ' Create shortcut, copy shortcut to desktop
        sShortcutLnk = sDirChromeMain & "Chrome " & sChromeVersionMajor & ".lnk"
        sDesktopLnk = oWShell.SpecialFolders("Desktop") & "\Chrome " & sChromeVersionMajor & ".lnk"
        sChromeLaunchExe = sDirChromeMainVersion & "\chrome.exe"
        sChromeLaunchArguments = _
            " --user-data-dir=""" & sFolderChromeUserDataVersion & """" & _
            " --chrome-version=" & sChromeVersionFull
        CreateShortcut _
            sShortcutLnk, _
            sChromeLaunchExe, _
            sChromeLaunchArguments, _
            sDirChromeMain
        If not oFSO.FileExists(sDesktopLnk) Then
            oFSO.CopyFile sShortcutLnk, sDesktopLnk
        End If
        
        ' Create Userdata directories
        If oFSO.FolderExists(sFolderChromeUserDataDefault) Then
            On Error Resume Next
            Do
                Err.Clear
                oFSO.CopyFolder sFolderChromeUserDataDefault, sFolderChromeUserDataVersion
                If Err.Number <> 0 Then
                    choice = MsgBox(_
                            "Source locked, or target already exist." & vbCrLf &_
                            "Close any applications that use the default Chrome directory, " _
                            & vbCrLf & sFolderChromeUserDataDefault & vbCrLf &_
                            "Do you want to start Chrome without duplicating the profile?",_
                            vbAbortRetryIgnore Or vbExclamation Or vbApplicationModal, _
                            "Error: " & Err.Description _
                             )
                    Select Case choice
                        Case vbAbort
                            WScript.Quit
                        Case vbIgnore
                            Exit Do
                    End Select
                Else
                    Exit Do
                End If
            Loop
        Else
            WScript.Echo "Base directory does not exists: " & vbCrLf & sFolderChromeUserDataDefault
        End If
        
        choice = MsgBox("Start Chrome " & sChromeVersionMajor & "?",_
                        vbOkCancel, "Launch Chrome " & sChromeVersionMajor & "?")
        If choice = vbOk Then
            Set oLaunch = CreateObject("WScript.Shell")
            oLaunch.CurrentDirectory = sDirChromeMain
            oLaunch.Run """" & sChromeLaunchExe & """" & sChromeLaunchArguments, 1, 0
        End If
        
        ' CleanUp
        If oFSO.FileExists(TMP & "chrome.7z") Then
            oFSO.DeleteFile TMP & "chrome.7z", True
        End If
        If oFSO.FolderExists(sDirChromeBin) Then
            oFSO.DeleteFolder RemoveTrailingSlash(sDirChromeBin), True
        End If
        
    ElseIf oFSO.FileExists(TMP & "chrome.7z") Then
        WScript.Echo TMP & "chrome.7z  exists, but Chrome-bin\ does not!"
    Else
        WScript.Echo TMP & "chrome.7z and Chrome-bin do not exist!"
    End If
End Sub

Sub CreateShortcut(sShortcut, sTargetPath, sArguments, sWorkingDirectory)
    sShortcut = oWShell.ExpandEnvironmentStrings(sShortcut)
    Dim oSC
    set oSC = oWShell.CreateShortcut(sShortcut) 
    oSC.TargetPath = oWShell.ExpandEnvironmentStrings(sTargetPath)
    oSC.Arguments = oWShell.ExpandEnvironmentStrings(sArguments)
    oSC.WorkingDirectory = oWShell.ExpandEnvironmentStrings(sWorkingDirectory)
    oSC.Save
End Sub

Function RemoveTrailingSlash(sPath)       
    If Right(sPath, 1) = "\" Then
        RemoveTrailingSlash = Left(sPath, Len(sPath) - 1)
    Else
        RemoveTrailingSlash = sPath
    End If
End Function

https://stackoverflow.com/questions/3785991/can-i-run-multiple-versions-of-google-chrome-on-the-same-machine-mac-or-window