public
Last active

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

  • Download Gist
installChrome.vbs
Visual Basic
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316
' Author: Rob W <gwnRob@gmail.com>
' 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

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.