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.
|
