1

Тема: Установка и настройка Google Chrome через VBS

Приветствую всех.

Помогите пожалуйста нужен скрипт выполняющий функции:

1. Определение установлен ли браузер Хром на машине или нет, если нет, то скачивание файла с интернета (браузер хром)
2. Тихая установка браузера Хром
3. Браузер Хром по умолчанию основной
4. Установка расширения в браузере Хром (и запуск расширения)
5. Отключение всплывающих окон в браузере хром
6. Добавление закладки в браузере Хром


Единственное знаю как скачать файл из интернета и как сделать браузер основным.. больше ничего не знаю.. помогите пожалуйста как будет выглядеть данный скрипт из этих пунктов....

2

Re: Установка и настройка Google Chrome через VBS

Для определения имеется ли Chrome на ПК или нет, можно использовать следующий код:

Option Explicit

Dim bFound, sChromePath, lChromeVersion

CheckChrome bFound, sChromePath, lChromeVersion
If bFound Then
	MsgBox "Путь: " & sChromePath & vbCrLf & "Версия: " & lChromeVersion
Else
	MsgBox "Chrome не найден"
End If


Sub CheckChrome(bFound, sChromePath, lChromeVersion)
	
	Dim sUrl, sPath, oWshShell, oWshExec, oStdOut, sContent
	
	bFound = False
	' Проверка Chrome в установленных программах
	CheckChromeInstall bFound, sChromePath, lChromeVersion
	If Not bFound Then
		' Проверка Chrome в стандартных папках
		CheckChromeFolders bFound, sChromePath, lChromeVersion
		If Not bFound Then Exit Sub
	End If
	
End Sub

Sub CheckChromeInstall(bFound, sChromePath, lChromeVersion)
	
	' Проверка Chrome в установленных программах
	
	Const HKLM = &H80000002 ' HKEY_LOCAL_MACHINE
	Dim oReg, sKey, aSubkeys, sSubkey, iRet, sValue, sInstallLocation, sVersion
	
	bFound = False
	Set oReg = GetObject("winmgmts://./root/default:StdRegProv")
	For Each sKey In Array("SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\", "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall\")
		oReg.EnumKey HKLM, sKey, aSubkeys
		If Not IsNull(aSubkeys) Then
			For Each sSubkey In aSubkeys
				iRet = oReg.GetStringValue(HKLM, sKey & sSubkey, "DisplayName", sValue)
				If iRet <> 0 Then oReg.GetStringValue HKLM, sKey & sSubkey, "QuietDisplayName", sValue
				If sValue = "Google Chrome" Then
					oReg.GetStringValue HKLM, sKey & sSubkey, "InstallLocation", sInstallLocation
					oReg.GetStringValue HKLM, sKey & sSubkey, "Version", sVersion
					Select Case True
						Case IsNull(sInstallLocation)
						Case sInstallLocation = ""
						Case Not CreateObject("Scripting.FileSystemObject").FileExists(sInstallLocation & "\chrome.exe")
						Case IsNull(sVersion)
						Case sVersion = ""
						Case Not IsNumeric(Split(sVersion, ".", 2)(0))
						Case Else
							bFound = True
							sChromePath = sInstallLocation & "\chrome.exe"
							lChromeVersion = CLng(Split(sVersion, ".", 2)(0))
						Exit Sub
					End Select
				End If
			Next
		End If
	Next
	
End Sub

Sub CheckChromeFolders(bFound, sChromePath, lChromeVersion)
	
	' Проверка Chrome в стандартных папках
	
	Dim oFolders, sFolder, sPath, lVersion
	
	bFound = False
	Set oFolders = CreateObject("Scripting.Dictionary")
	With CreateObject("WScript.Shell")
		oFolders.Item(.Environment("process").Item("localappdata")) = ""
		oFolders.Item(.Environment("process").Item("programfiles")) = ""
		oFolders.Item(.Environment("process").Item("programfiles(x86)")) = ""
		oFolders.Item(.Environment("process").Item("programw6432")) = ""
		oFolders.Item(.ExpandEnvironmentStrings("%programfiles%")) = ""
		oFolders.Item(.ExpandEnvironmentStrings("%programfiles(x86)%")) = ""
	End With
	With CreateObject("Shell.Application")
		oFolders.Item(.Namespace(&H26).Self.Path) = ""
		oFolders.Item(.Namespace(&H2A).Self.Path) = ""
	End With
	For Each sFolder In oFolders
		sPath = sFolder & "\Google\Chrome\Application\chrome.exe"
		If CreateObject("Scripting.FileSystemObject").FileExists(sPath) Then
			lVersion = GetFileVersion(sPath)
			If lVersion <> "" Then
				bFound = True
				sChromePath = sPath
				lChromeVersion = lVersion
				Exit Sub
			End If
		End If
	Next
	
End Sub

Function GetFileVersion(sPath)
	
	Dim oShell, oFolder, oFile, i, sName, sVersion, sFolderName, sFileName
	
	GetFileVersion = ""
	SplitFullPath sPath, sFolderName, sFileName
	Set oShell = CreateObject("Shell.Application")
	Set oFolder = oShell.Namespace(sFolderName)
	Set oFile = oFolder.ParseName(sFileName)
	For i = 0 To 511
		sName = oFolder.GetDetailsOf(oFolder.Items, i)
		If LCase(sName) = "версия файла" Or LCase(sName) = "file version" Then
			sVersion = oFolder.GetDetailsOf(oFile, i)
			Select Case True
				Case sVersion = ""
				Case Not IsNumeric(Split(sVersion, ".", 2)(0))
				Case Else
					GetFileVersion = CLng(Split(sVersion, ".", 2)(0))
					Exit Function
			End Select
			Exit Function
		End If
	Next
	
End Function

Sub SplitFullPath(sPath, sFolderName, sFileName)
	
	With CreateObject("Scripting.FileSystemObject")
		If Not .FileExists(sPath) Then Exit Sub
		sFolderName = .GetParentFoldername(sPath)
		sFileName = .GetFileName(sPath)
	End With
	
End Sub
+ Небольшой оффтоп на тему Headless Chrome

Раз уж тема коснулась Chrome, пожалуй, опубликую еще один небольшой кусок кода, разработанный вместе с представленным выше. Это пример использования Headless Chrome для получения HTML содержимого страниц. Вероятно, кому-то будет интересно, в качестве альтернативы IE, вопрос пока вроде не особо обсуждался.

Option Explicit

Dim oHeadlessChrome

Set oHeadlessChrome = New clsHeadlessChrome

If oHeadlessChrome.IsAvailable Then
	MsgBox oHeadlessChrome.GetContent("https://api.myip.com/")
Else
	MsgBox "Headless Chrome недоступен" 
End If

Class clsHeadlessChrome
	
	Private psChromePath, pbAvailable
	
	Private Sub Class_Initialize()
		
		Dim bFound, lChromeVersion
		
		CheckChrome bFound, psChromePath, lChromeVersion
		pbAvailable = bFound And (lChromeVersion >= 59)
		
	End Sub
	
	Function GetContent(sUrl)
		
		Const BlankPage = "<html><head></head><body></body></html>"
		
		Dim oWshShell, oWshExec, oStdOut, sContent, sCmd
		
		GetContent = ""
		If Not pbAvailable Then Exit Function
		Set oWshShell = CreateObject("WScript.Shell")
		sCmd = """" & psChromePath & """ --headless --disable-gpu --dump-dom " & sUrl
		Set oWshExec = oWshShell.Exec(sCmd)
		Set oStdOut = oWshExec.StdOut
		sContent = oStdOut.ReadAll
		If Mid(sContent, 1, Len(BlankPage)) <> BlankPage Then GetContent = sContent
		
	End Function
	
	Public Property Get IsAvailable()
		
		IsAvailable = pbAvailable
		
	End Property
	
	Private Sub CheckChrome(bFound, sChromePath, lChromeVersion)
		
		Dim sUrl, sPath, oWshShell, oWshExec, oStdOut, sContent
		
		bFound = False
		' Проверка Chrome в установленных программах
		CheckChromeInstall bFound, sChromePath, lChromeVersion
		If Not bFound Then
			' Проверка Chrome в стандартных папках
			CheckChromeFolders bFound, sChromePath, lChromeVersion
		End If
		
	End Sub
	
	Private Sub CheckChromeInstall(bFound, sChromePath, lChromeVersion)
		
		' Проверка Chrome в установленных программах
		
		Const HKLM = &H80000002 ' HKEY_LOCAL_MACHINE
		Dim oReg, sKey, aSubkeys, sSubkey, iRet, sValue, sInstallLocation, sVersion
		
		bFound = False
		Set oReg = GetObject("winmgmts://./root/default:StdRegProv")
		For Each sKey In Array("SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\", "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall\")
			oReg.EnumKey HKLM, sKey, aSubkeys
			If Not IsNull(aSubkeys) Then
				For Each sSubkey In aSubkeys
					iRet = oReg.GetStringValue(HKLM, sKey & sSubkey, "DisplayName", sValue)
					If iRet <> 0 Then oReg.GetStringValue HKLM, sKey & sSubkey, "QuietDisplayName", sValue
					If sValue = "Google Chrome" Then
						oReg.GetStringValue HKLM, sKey & sSubkey, "InstallLocation", sInstallLocation
						oReg.GetStringValue HKLM, sKey & sSubkey, "Version", sVersion
						Select Case True
							Case IsNull(sInstallLocation)
							Case sInstallLocation = ""
							Case Not CreateObject("Scripting.FileSystemObject").FileExists(sInstallLocation & "\chrome.exe")
							Case IsNull(sVersion)
							Case sVersion = ""
							Case Not IsNumeric(Split(sVersion, ".", 2)(0))
							Case Else
								bFound = True
								sChromePath = sInstallLocation & "\chrome.exe"
								lChromeVersion = CLng(Split(sVersion, ".", 2)(0))
							Exit Sub
						End Select
					End If
				Next
			End If
		Next
		
	End Sub
	
	Private Sub CheckChromeFolders(bFound, sChromePath, lChromeVersion)
		
		' Проверка Chrome в стандартных папках
		
		Dim oFolders, sFolder, sPath, lVersion
		
		bFound = False
		Set oFolders = CreateObject("Scripting.Dictionary")
		With CreateObject("WScript.Shell")
			oFolders.Item(.Environment("process").Item("localappdata")) = ""
			oFolders.Item(.Environment("process").Item("programfiles")) = ""
			oFolders.Item(.Environment("process").Item("programfiles(x86)")) = ""
			oFolders.Item(.Environment("process").Item("programw6432")) = ""
			oFolders.Item(.ExpandEnvironmentStrings("%programfiles%")) = ""
			oFolders.Item(.ExpandEnvironmentStrings("%programfiles(x86)%")) = ""
		End With
		With CreateObject("Shell.Application")
			oFolders.Item(.Namespace(&H26).Self.Path) = ""
			oFolders.Item(.Namespace(&H2A).Self.Path) = ""
		End With
		For Each sFolder In oFolders
			sPath = sFolder & "\Google\Chrome\Application\chrome.exe"
			If CreateObject("Scripting.FileSystemObject").FileExists(sPath) Then
				lVersion = GetFileVersion(sPath)
				If lVersion <> "" Then
					bFound = True
					sChromePath = sPath
					lChromeVersion = lVersion
					Exit Sub
				End If
			End If
		Next
		
	End Sub
	
	Private Function GetFileVersion(sPath)
		
		Dim oShell, oFolder, oFile, i, sName, sVersion, sFolderName, sFileName
		
		GetFileVersion = ""
		SplitFullPath sPath, sFolderName, sFileName
		Set oShell = CreateObject("Shell.Application")
		Set oFolder = oShell.Namespace(sFolderName)
		Set oFile = oFolder.ParseName(sFileName)
		For i = 0 To 511
			sName = oFolder.GetDetailsOf(oFolder.Items, i)
			If LCase(sName) = "версия файла" Or LCase(sName) = "file version" Then
				sVersion = oFolder.GetDetailsOf(oFile, i)
				Select Case True
					Case sVersion = ""
					Case Not IsNumeric(Split(sVersion, ".", 2)(0))
					Case Else
						GetFileVersion = CLng(Split(sVersion, ".", 2)(0))
						Exit Function
				End Select
				Exit Function
			End If
		Next
		
	End Function
	
	Private Sub SplitFullPath(sPath, sFolderName, sFileName)
		
		With CreateObject("Scripting.FileSystemObject")
			If Not .FileExists(sPath) Then Exit Sub
			sFolderName = .GetParentFoldername(sPath)
			sFileName = .GetFileName(sPath)
		End With
		
	End Sub
	
End Class

Работает, начиная с версии Chrome 59. Описание прочих возможностей (создание скриншотов страницы и сохранение в формате PDF) и параметров командной строки можно найти по ссылке.
Оговорюсь, что код относительно сыроват, для некоторых страниц нужно отлаживать кодировку символов, и, не исключено, добавлять проверку на таймаут.

Щт Уккщк Куыгьу Туче
’ҐЄгй п Є®¤®ў п бва Ёж : 1251

3

Re: Установка и настройка Google Chrome через VBS

omegastripes

Подскажите в данном коде расширение устанавливается из магазина  браузера или как сторонний файл?? Есть ли возможность как из магазина установить ?

4

Re: Установка и настройка Google Chrome через VBS

cherfull22
Приведенный код только определяет наличие Chrome.

Щт Уккщк Куыгьу Туче
’ҐЄгй п Є®¤®ў п бва Ёж : 1251