[Iska]

adm1nb3k, на Ваш страх и риск:

Код:

Option Explicit

Const HKEY_CURRENT_USER  = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002

Const ForReading   = 1
Const ForWriting   = 2
Const ForAppending = 8

Const strHomePage = "about:blank"


Dim strComputer

Dim objSWbemLocator
Dim objSWbemServicesEx
Dim objSWbemObjectEx

Dim objFSO
Dim objINIEdit


strComputer = "."

Set objSWbemLocator    = WScript.CreateObject("WbemScripting.SWbemLocator")
Set objSWbemServicesEx = objSWbemLocator.ConnectServer(strComputer, "root\default")
Set objSWbemObjectEx   = objSWbemServicesEx.Get("StdRegProv")

Set objFSO             = WScript.CreateObject("Scripting.FileSystemObject")
Set objINIEdit         = WScript.CreateObject("JSSys3.INIEdit")

ChangeIEHomePage
ChangeFirefoxHomePage
ChangeOperaHomePage
ChangeChromeHomePage

Set objINIEdit         = Nothing
Set objFSO             = Nothing

Set objSWbemObjectEx   = Nothing
Set objSWbemServicesEx = Nothing
Set objSWbemLocator    = Nothing

WScript.Quit 0
'=============================================================================

'=============================================================================
Sub ChangeIEHomePage()
	If objSWbemObjectEx.SetStringValue(HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Internet Explorer\Main", "Start Page", strHomePage) = 0 Then
		WScript.Echo "Internet Explorer home page set succesfully"
	Else
		WScript.Echo "Can't set Internet Explorer home page"
	End If
End Sub
'=============================================================================

'=============================================================================
Sub ChangeFirefoxHomePage()
	Dim strCurrentVersion
	Dim strProfilesFileName
	Dim boolFound
	Dim strSection
	Dim strProfilePath
	Dim strPrefsPath
	Dim objRegExp_HomePage
	Dim strContent
	
	If objSWbemObjectEx.GetStringValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Mozilla\Mozilla Firefox", "CurrentVersion", strCurrentVersion) = 0 Then
		strProfilesFileName = WScript.CreateObject("Shell.Application").NameSpace("shell:AppData").Self.Path & "\Mozilla\Firefox\profiles.ini"
		
		If objFSO.FileExists(strProfilesFileName) Then
			boolFound = False
			
			For Each strSection In Split(objINIEdit.GetIniSectionNames(strProfilesFileName), vbNullChar)
				If objINIEdit.GetIniVal(strProfilesFileName, strSection, "Default") = "1" Then
					boolFound = True
					
					Exit For
				End If
			Next
			
			If Not boolFound Then
				strSection = "Profile0"
			End If
			
			Select Case objINIEdit.GetIniVal(strProfilesFileName, strSection, "IsRelative")
				Case "0"
				strProfilePath = objINIEdit.GetIniVal(strProfilesFileName, strSection, "Path")
				Case "1"
				strProfilePath = objFSO.BuildPath(objFSO.GetParentFolderName(strProfilesFileName), objINIEdit.GetIniVal(strProfilesFileName, strSection, "Path"))
				Case Else
				WScript.Echo "Can't find Firefox default profile"
				
				Exit Sub
			End Select
			
			strPrefsPath = objFSO.BuildPath(strProfilePath, "prefs.js")
			
			If objFSO.FileExists(strPrefsPath) Then
				Set objRegExp_HomePage = WScript.CreateObject("VBScript.RegExp")
				
				With objRegExp_HomePage
					.Global     = False
					.IgnoreCase = True
					.Pattern    = "(user_pref\(""browser\.startup\.homepage"", )(.*)(\);)"
				End With
				
				With objFSO.OpenTextFile(strPrefsPath, ForReading)
					strContent = .ReadAll()
					.Close
				End With
				
				If objRegExp_HomePage.Test(strContent) Then
					With objFSO.OpenTextFile(strPrefsPath, ForWriting)
						.Write objRegExp_HomePage.Replace(strContent, "$1""" & strHomePage & """$3")
						.Close
					End With
				Else
					With objFSO.OpenTextFile(strPrefsPath, ForAppending)
						.WriteLine "user_pref(""browser.startup.homepage"", """ & strHomePage & """);"
						.Close
					End With
				End If
				
				Set objRegExp_HomePage = Nothing
				
				WScript.Echo "Firefox home page set succesfully"
			Else
				WScript.Echo "Can't find Firefox preference file [" & strPrefsPath & "]"
			End If
		Else
			WScript.Echo "Can't find Firefox profiles file [" & strProfilesFileName & "]"
		End If
	Else
		WScript.Echo "Can't find Mozilla Firefox"
	End If
End Sub
'=============================================================================

'=============================================================================
Sub ChangeOperaHomePage()
	Dim strPrefsPath
	
	strPrefsPath = WScript.CreateObject("Shell.Application").NameSpace("shell:AppData").Self.Path & "\Opera\Opera\operaprefs.ini"
	
	If objFSO.FileExists(strPrefsPath) Then
		If objINIEdit.WriteIniVal(strPrefsPath, "User Prefs", "Home URL", strHomePage) Then
			WScript.Echo "Opera home page set succesfully"
		Else
			WScript.Echo "Can't set Opera home page"
		End If
	Else
		WScript.Echo "Can't find Opera preference file [" & strPrefsPath & "]"
	End If
End Sub
'=============================================================================

'=============================================================================
Sub ChangeChromeHomePage()
	Dim strPrefsPath
	Dim objRegExp_HomePage
	Dim strContent
	
	
	strPrefsPath = WScript.CreateObject("Shell.Application").NameSpace("shell:Local AppData").Self.Path & "\Google\Chrome\User Data\Default\Preferences"
	
	If objFSO.FileExists(strPrefsPath) Then
		Set objRegExp_HomePage = WScript.CreateObject("VBScript.RegExp")
		
		With objRegExp_HomePage
			.Global     = False
			.IgnoreCase = True
			.Pattern    = "(""homepage"": )("".*"")(,)"
		End With
		
		With objFSO.OpenTextFile(strPrefsPath, ForReading)
			strContent = .ReadAll()
			.Close
		End With
		
		If objRegExp_HomePage.Test(strContent) Then
			With objFSO.OpenTextFile(strPrefsPath, ForWriting)
				.Write objRegExp_HomePage.Replace(strContent, "$1""" & strHomePage & """$3")
				.Close
			End With
			
			WScript.Echo "Chrome home page set succesfully"
		Else
			WScript.Echo "Can't set Chrome home page"
		End If
		
		Set objRegExp_HomePage = Nothing
	Else
		WScript.Echo "Can't find Chrome preference file [" & strPrefsPath & "]"
	End If
End Sub
'=============================================================================

Не рассчитано на кириллические адреса. Для работы требуется зарегистрированная библиотека JSSys3.dll - System info. and operations component.